diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index f5c0de2ea2..e9a709030e 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -266,26 +266,6 @@ HELP: spread-curry { $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* } "." } { $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*" } "." } ; -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." } ; - HELP: mnswap { $values { "m" integer } { "n" integer } } { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." } @@ -401,11 +381,6 @@ ARTICLE: "combinator-generalizations" "Generalized combinators" apply-curry cleave-curry spread-curry - neach - nmap - nmap-as - mnmap - mnmap-as } ; ARTICLE: "other-generalizations" "Additional generalizations" @@ -424,6 +399,7 @@ ARTICLE: "generalizations" "Generalized shuffle words and combinators" "shuffle-generalizations" "combinator-generalizations" "other-generalizations" -} ; +} +"Also see the " { $vocab-link "sequences.generalizations" } " vocabulary for generalized sequence iteration combinators." ; ABOUT: "generalizations" diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index cb2c40ca0a..c54e35002f 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -82,108 +82,6 @@ IN: generalizations.tests [ '[ number>string _ append ] 4 napply ] must-infer -: 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 - [ 6 8 10 12 ] [ 1 2 3 4 5 6 7 8 [ + ] 4 apply-curry 4 spread* diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 2ae076655e..8d6d6f2ac0 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -142,57 +142,3 @@ 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 @ ] ; - -: 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 - diff --git a/basis/sequences/generalizations/generalizations-docs.factor b/basis/sequences/generalizations/generalizations-docs.factor new file mode 100644 index 0000000000..d2e8c0c5fc --- /dev/null +++ b/basis/sequences/generalizations/generalizations-docs.factor @@ -0,0 +1,36 @@ +! (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" diff --git a/basis/sequences/generalizations/generalizations-tests.factor b/basis/sequences/generalizations/generalizations-tests.factor new file mode 100644 index 0000000000..ac1990743e --- /dev/null +++ b/basis/sequences/generalizations/generalizations-tests.factor @@ -0,0 +1,107 @@ +! (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 + diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor new file mode 100644 index 0000000000..4365c1494d --- /dev/null +++ b/basis/sequences/generalizations/generalizations.factor @@ -0,0 +1,59 @@ +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 + diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index 72f5cb5517..62bd45938b 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -1,7 +1,8 @@ ! (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