{ $description "Curries the " { $snippet "n" } " quotations on the top of the datastack with the " { $snippet "n" } " values just below them. A generalization of " { $link bi-curry* } " and " { $link tri-curry* } "." }\r
{ $notes "This word can be used with " { $link cleave* } " and " { $link spread* } " to generalize dataflow patterns such as " { $snippet "bi-curry* bi" } ", " { $snippet "tri-curry* tri" } ", " { $snippet "bi-curry* bi*" } ", and " { $snippet "tri-curry* tri*" } "." } ;\r
\r
-HELP: neach\r
-{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- )" } } { "n" integer } }\r
-{ $description "A generalization of " { $link each } ", " { $link 2each } ", and " { $link 3each } " that can iterate over any number of sequences in parallel." } ;\r
-\r
-HELP: nmap\r
-{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "n" integer } { "result" "a sequence of the same type as the first " { $snippet "seq" } } }\r
-{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel." } ;\r
-\r
-HELP: nmap-as\r
-{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "exemplar" sequence } { "n" integer } { "result" "a sequence of the same type as " { $snippet "exemplar" } } }\r
-{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel." } ;\r
-\r
-HELP: mnmap\r
-{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the first " { $snippet "seq" } } }\r
-{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel and provide any number of output sequences." } ;\r
-\r
-HELP: mnmap-as\r
-{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "n*exemplar" { $snippet "n" } " sequences on the datastack" } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the " { $snippet "exemplar" } "s" } }\r
-{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel and provide any number of output sequences of distinct types." } ;\r
-\r
HELP: mnswap\r
{ $values { "m" integer } { "n" integer } }\r
{ $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }\r
apply-curry\r
cleave-curry\r
spread-curry\r
- neach\r
- nmap\r
- nmap-as\r
- mnmap\r
- mnmap-as\r
} ;\r
\r
ARTICLE: "other-generalizations" "Additional generalizations"\r
"shuffle-generalizations"\r
"combinator-generalizations"\r
"other-generalizations"\r
-} ;\r
+}\r
+"Also see the " { $vocab-link "sequences.generalizations" } " vocabulary for generalized sequence iteration combinators." ;\r
\r
ABOUT: "generalizations"\r
\r
[ '[ number>string _ append ] 4 napply ] must-infer\r
\r
-: neach-test ( a b c d -- )\r
- [ 4 nappend print ] 4 neach ;\r
-: nmap-test ( a b c d -- e )\r
- [ 4 nappend ] 4 nmap ;\r
-: nmap-as-test ( a b c d -- e )\r
- [ 4 nappend ] [ ] 4 nmap-as ;\r
-: mnmap-3-test ( a b c d -- e f g )\r
- [ append ] 4 3 mnmap ;\r
-: mnmap-2-test ( a b c d -- e f )\r
- [ [ append ] 2bi@ ] 4 2 mnmap ;\r
-: mnmap-as-test ( a b c d -- e f )\r
- [ [ append ] 2bi@ ] { } [ ] 4 2 mnmap-as ;\r
-: mnmap-1-test ( a b c d -- e )\r
- [ 4 nappend ] 4 1 mnmap ;\r
-: mnmap-0-test ( a b c d -- )\r
- [ 4 nappend print ] 4 0 mnmap ;\r
-\r
-[ """A1a!\r
-B2b@\r
-C3c#\r
-D4d$\r
-""" ] [\r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- [ neach-test ] with-string-writer\r
-] unit-test\r
-\r
-[ { "A1a!" "B2b@" "C3c#" "D4d$" } ]\r
-[ \r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- nmap-test\r
-] unit-test\r
-\r
-[ [ "A1a!" "B2b@" "C3c#" "D4d$" ] ]\r
-[ \r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- nmap-as-test\r
-] unit-test\r
-\r
-[\r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a!" "b@" "c#" "d$" }\r
-] [ \r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- mnmap-3-test\r
-] unit-test\r
-\r
-[\r
- { "A1" "B2" "C3" "D4" }\r
- { "a!" "b@" "c#" "d$" }\r
-] [ \r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- mnmap-2-test\r
-] unit-test\r
-\r
-[\r
- { "A1" "B2" "C3" "D4" }\r
- [ "a!" "b@" "c#" "d$" ]\r
-] [ \r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- mnmap-as-test\r
-] unit-test\r
-\r
-[ { "A1a!" "B2b@" "C3c#" "D4d$" } ]\r
-[ \r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- mnmap-1-test\r
-] unit-test\r
-\r
-[ """A1a!\r
-B2b@\r
-C3c#\r
-D4d$\r
-""" ] [\r
- { "A" "B" "C" "D" }\r
- { "1" "2" "3" "4" }\r
- { "a" "b" "c" "d" }\r
- { "!" "@" "#" "$" }\r
- [ mnmap-0-test ] with-string-writer\r
-] unit-test\r
-\r
[ 6 8 10 12 ] [\r
1 2 3 4\r
5 6 7 8 [ + ] 4 apply-curry 4 spread*\r
MACRO: nspin ( n -- )
[ [ ] ] swap [ swap [ ] curry compose ] n*quot [ call ] 3append ;
-MACRO: nmin-length ( n -- )
- dup 1 - [ min ] n*quot
- '[ [ length ] _ napply @ ] ;
-
-: nnth-unsafe ( n ...seq n -- )
- [ nth-unsafe ] swap [ apply-curry ] [ cleave* ] bi ; inline
-MACRO: nset-nth-unsafe ( n -- )
- [ [ drop ] ]
- [ '[ [ set-nth-unsafe ] _ [ apply-curry ] [ cleave-curry ] [ spread* ] tri ] ]
- if-zero ;
-
-: (neach) ( ...seq quot n -- len quot' )
- dup dup dup
- '[ [ _ nmin-length ] _ nkeep [ _ nnth-unsafe ] _ ncurry ] dip compose ; inline
-
-: 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
-
-MACRO: nnew-sequence ( n -- )
- [ [ drop ] ]
- [ dup '[ [ new-sequence ] _ apply-curry _ cleave* ] ] if-zero ;
-
-: nnew-like ( len ...exemplar quot n -- result... )
- dup dup dup dup '[
- _ nover
- [ [ _ nnew-sequence ] dip call ]
- _ ndip [ like ]
- _ apply-curry
- _ spread*
- ] call ; inline
-
-MACRO: (ncollect) ( n -- )
- dup dup 1 +
- '[ [ [ keep ] _ ndip _ nset-nth-unsafe ] _ ncurry ] ;
-
-: ncollect ( len quot ...into n -- )
- (ncollect) each-integer ; inline
-
-: nmap-integers ( len quot ...exemplar n -- result... )
- dup dup dup
- '[ [ over ] _ ndip [ [ _ ncollect ] _ nkeep ] _ nnew-like ] call ; inline
-
-: mnmap-as ( m*seq quot n*exemplar m n -- result*n )
- dup '[ [ _ (neach) ] _ ndip _ nmap-integers ] call ; inline
-
-: mnmap ( m*seq quot m n -- result*n )
- 2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline
-
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: help.syntax help.markup kernel sequences quotations
+math arrays combinators ;
+IN: sequences.generalizations
+
+HELP: neach
+{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "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" { $snippet "n" } " sequences on the datastack" } { "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" { $snippet "n" } " sequences on the datastack" } { "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: mnmap
+{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences 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 and provide any number of output sequences." } ;
+
+HELP: mnmap-as
+{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "n*exemplar" { $snippet "n" } " sequences on the datastack" } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the " { $snippet "exemplar" } "s" } }
+{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel and provide any number of output sequences of distinct types." } ;
+
+ARTICLE: "sequences.generalizations" "Generalized sequence iteration combinators"
+"The " { $vocab-link "sequences.generalizations" } " vocabulary defines generalized versions of the iteration " { $link "sequences-combinators" } "."
+{ $subsections
+ neach
+ nmap
+ nmap-as
+ mnmap
+ mnmap-as
+} ;
+
+ABOUT: "sequences.generalizations"
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: tools.test generalizations kernel math arrays sequences
+sequences.generalizations ascii fry math.parser io io.streams.string ;
+IN: sequences.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 ;
+: mnmap-3-test ( a b c d -- e f g )
+ [ append ] 4 3 mnmap ;
+: mnmap-2-test ( a b c d -- e f )
+ [ [ append ] 2bi@ ] 4 2 mnmap ;
+: mnmap-as-test ( a b c d -- e f )
+ [ [ append ] 2bi@ ] { } [ ] 4 2 mnmap-as ;
+: mnmap-1-test ( a b c d -- e )
+ [ 4 nappend ] 4 1 mnmap ;
+: mnmap-0-test ( a b c d -- )
+ [ 4 nappend print ] 4 0 mnmap ;
+
+[ """A1a!
+B2b@
+C3c#
+D4d$
+""" ] [
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a" "b" "c" "d" }
+ { "!" "@" "#" "$" }
+ [ 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
+
+[
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a!" "b@" "c#" "d$" }
+] [
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a" "b" "c" "d" }
+ { "!" "@" "#" "$" }
+ mnmap-3-test
+] unit-test
+
+[
+ { "A1" "B2" "C3" "D4" }
+ { "a!" "b@" "c#" "d$" }
+] [
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a" "b" "c" "d" }
+ { "!" "@" "#" "$" }
+ mnmap-2-test
+] unit-test
+
+[
+ { "A1" "B2" "C3" "D4" }
+ [ "a!" "b@" "c#" "d$" ]
+] [
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a" "b" "c" "d" }
+ { "!" "@" "#" "$" }
+ mnmap-as-test
+] unit-test
+
+[ { "A1a!" "B2b@" "C3c#" "D4d$" } ]
+[
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a" "b" "c" "d" }
+ { "!" "@" "#" "$" }
+ mnmap-1-test
+] unit-test
+
+[ """A1a!
+B2b@
+C3c#
+D4d$
+""" ] [
+ { "A" "B" "C" "D" }
+ { "1" "2" "3" "4" }
+ { "a" "b" "c" "d" }
+ { "!" "@" "#" "$" }
+ [ mnmap-0-test ] with-string-writer
+] unit-test
+
--- /dev/null
+USING: kernel sequences sequences.private math
+combinators macros math.order math.ranges quotations fry effects
+memoize.private generalizations ;
+IN: sequences.generalizations
+
+MACRO: nmin-length ( n -- )
+ dup 1 - [ min ] n*quot
+ '[ [ length ] _ napply @ ] ;
+
+: nnth-unsafe ( n ...seq n -- )
+ [ nth-unsafe ] swap [ apply-curry ] [ cleave* ] bi ; inline
+MACRO: nset-nth-unsafe ( n -- )
+ [ [ drop ] ]
+ [ '[ [ set-nth-unsafe ] _ [ apply-curry ] [ cleave-curry ] [ spread* ] tri ] ]
+ if-zero ;
+
+: (neach) ( ...seq quot n -- len quot' )
+ dup dup dup
+ '[ [ _ nmin-length ] _ nkeep [ _ nnth-unsafe ] _ ncurry ] dip compose ; inline
+
+: 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
+
+MACRO: nnew-sequence ( n -- )
+ [ [ drop ] ]
+ [ dup '[ [ new-sequence ] _ apply-curry _ cleave* ] ] if-zero ;
+
+: nnew-like ( len ...exemplar quot n -- result... )
+ dup dup dup dup '[
+ _ nover
+ [ [ _ nnew-sequence ] dip call ]
+ _ ndip [ like ]
+ _ apply-curry
+ _ spread*
+ ] call ; inline
+
+MACRO: (ncollect) ( n -- )
+ dup dup 1 +
+ '[ [ [ keep ] _ ndip _ nset-nth-unsafe ] _ ncurry ] ;
+
+: ncollect ( len quot ...into n -- )
+ (ncollect) each-integer ; inline
+
+: nmap-integers ( len quot ...exemplar n -- result... )
+ dup dup dup
+ '[ [ over ] _ ndip [ [ _ ncollect ] _ nkeep ] _ nnew-like ] call ; inline
+
+: mnmap-as ( m*seq quot n*exemplar m n -- result*n )
+ dup '[ [ _ (neach) ] _ ndip _ nmap-integers ] call ; inline
+
+: mnmap ( m*seq quot m n -- result*n )
+ 2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline
+
! (c)Joe Groff bsd license
USING: accessors alien alien.c-types alien.data alien.parser arrays
byte-arrays combinators effects.parser fry generalizations grouping kernel
-lexer locals macros make math math.ranges parser sequences sequences.private ;
+lexer locals macros make math math.ranges parser sequences
+sequences.generalizations sequences.private ;
FROM: alien.arrays => array-length ;
IN: alien.data.map
projects / factor.git / commitdiff