diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 3979e0518a..9fde1fd1b1 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -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" } } } } ; diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 1291012700..4eb4c4e686 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -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 diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index ae7437b346..a447d5c706 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -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 spread>quot ; MACRO: mnswap ( m n -- ) 1+ '[ _ -nrot ] spread>quot ;