Fix napply for n=1, and fix napply's docs
parent
b169b803d2
commit
3ba56e73c3
basis/generalizations
|
@ -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" } }
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue