steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

neach generalization

db4
Joe Groff 2009-10-14 00:09:57 -05:00
parent a67961736b
commit a0e27320df
3 changed files with 36 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/generalizations/generalizations-docs.factor
View File

@ -236,6 +236,10 @@ HELP: nspread
{ $description "A generalization of " { $link spread } " that can work for any quotation arity." { $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 HELP: mnswap
{ $values { "m" integer } { "n" integer } } { $values { "m" integer } { "n" integer } }
{ $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." } { $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 napply
ncleave ncleave
nspread nspread
neach
} ; } ;
ARTICLE: "other-generalizations" "Additional generalizations" ARTICLE: "other-generalizations" "Additional generalizations"

17
basis/generalizations/generalizations-tests.factor
View File

@ -1,5 +1,5 @@
USING: tools.test generalizations kernel math arrays sequences USING: tools.test generalizations kernel math arrays sequences
ascii fry math.parser ; ascii fry math.parser io io.streams.string ;
IN: generalizations.tests IN: generalizations.tests
{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test { 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 [ 1 2 3 4 1 2 3 ] [ nover-test ] unit-test
[ '[ number>string _ append ] 4 napply ] must-infer [ '[ 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

16
basis/generalizations/generalizations.factor
View File

@ -2,7 +2,7 @@
! Cavazos, Slava Pestov. ! Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private math combinators USING: kernel sequences sequences.private math combinators
macros quotations fry effects memoize.private ; macros math.order quotations fry effects memoize.private ;
IN: generalizations IN: generalizations
<< <<
@ -116,3 +116,17 @@ MACRO: nbi-curry ( n -- )
MACRO: nspin ( n -- ) MACRO: nspin ( n -- )
[ [ ] ] swap [ swap [ ] curry compose ] n*quot [ call ] 3append ; [ [ ] ] 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