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

Fix napply for n=1, and fix napply's docs

db4
Slava Pestov 2009-01-13 19:41:12 -06:00
parent b169b803d2
commit 3ba56e73c3
3 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -229,8 +229,9 @@ HELP: napply
{ $examples
"Some core words expressed in terms of " { $link napply } ":"
{ $table
{ { $link bi@ } { $snippet "1 napply" } }
{ { $link tri@ } { $snippet "2 napply" } }
{ { $link call } { $snippet "1 napply" } }
{ { $link bi@ } { $snippet "2 napply" } }
{ { $link tri@ } { $snippet "3 napply" } }
}
} ;

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

@ -1,4 +1,4 @@
USING: tools.test generalizations kernel math arrays sequences ;
USING: tools.test generalizations kernel math arrays sequences ascii ;
IN: generalizations.tests
{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
@ -28,6 +28,8 @@ IN: generalizations.tests
[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
[ "HELLO" ] [ "hello" [ >upper ] 1 napply ] unit-test
[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test
[ [ dup 2^ 2array ] 5 napply ] must-infer

6
basis/generalizations/generalizations.factor
View File

@ -73,10 +73,8 @@ MACRO: ncleave ( quots n -- )
[ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
compose ;
MACRO: napply ( n -- )
2 [a,b]
[ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ]
map concat >quotation [ call ] append ;
MACRO: napply ( quot n -- )
swap <repetition> spread>quot ;
MACRO: mnswap ( m n -- )
1+ '[ _ -nrot ] <repetition> spread>quot ;