Add mnapply, smart-apply. Docs incoming soon

basis/combinators/smart/smart-tests.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test combinators.smart math kernel accessors ;
+USING: accessors arrays combinators.smart kernel math
+tools.test ;
 IN: combinators.smart.tests
 
 : test-bi ( -- 9 11 )
@@ -59,3 +60,6 @@ IN: combinators.smart.tests
 
 [ 7 ] [ 10 3 smart-if-test ] unit-test
 [ 16 ] [ 25 41 smart-if-test ] unit-test
+
+[ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 3 smart-apply ] unit-test
+[ { 1 2 3 } { 4 5 6 } ] [ 1 2 3 4 5 6 [ 3array ] 2 smart-apply ] unit-test

basis/combinators/smart/smart.factor

@@ -51,3 +51,6 @@ MACRO: nullary ( quot -- quot' )
 
 MACRO: smart-if ( pred true false -- )
     '[ _ preserving _ _ if ] ;
+
+MACRO: smart-apply ( quot n -- )
+    [ dup inputs ] dip '[ _ _ mnapply ] ;

basis/generalizations/generalizations-tests.factor

@@ -108,3 +108,8 @@ IN: generalizations.tests
     2 1 0 -1 [ + ] [ - ] [ * ] [ / ] 4 spread-curry 4 spread*
 ] unit-test
 
+[ { 1 2 } { 3 4 } { 5 6 } ]
+[ 1 2 3 4 5 6 [ 2array ] 2 3 mnapply ] unit-test
+
+[ { 1 2 3 } { 4 5 6 } ]
+[ 1 2 3 4 5 6 [ 3array ] 3 2 mnapply ] unit-test

basis/generalizations/generalizations.factor

@@ -124,6 +124,10 @@ MACRO: cleave* ( n -- )
 MACRO: mnswap ( m n -- )
     1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
 
+MACRO: mnapply ( quot m n -- )
+    swap
+    [ swap '[ _ ] replicate ] dip '[ _ _ nspread ] ;
+
 MACRO: nweave ( n -- )
     [ dup iota <reversed> [ '[ _ _ mnswap ] ] with map ] keep
     '[ _ _ ncleave ] ;