Add mnapply, smart-apply. Docs incoming soon

diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor
index afafd174d3efd0b2167dc14b8122ca007627dab9..11624dcf1046d715b5ee27c144829977beb215e9 100644 (file)
--- a/basis/combinators/smart/smart-tests.factor
+++ b/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

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index 05185fec2ecb7c86b76427a887aa43a77b5b2b3d..3ad5b6c7eef4e7a2c0551c549d50e11a2e8970ab 100644 (file)
--- a/basis/combinators/smart/smart.factor
+++ b/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 ] ;

diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index 0c35f157142419ed6b1e912c6fe23707a950d3b8..84b6565de121fa725074f455b1fbdd1a283dcc46 100644 (file)
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -108,3 +108,8 @@ IN: generalizations.tests
     2 1 0 -1 [ + ] [ - ] [ * ] [ / ] 4 spread-curry 4 spread*\r
 ] unit-test\r
 \r
+[ { 1 2 } { 3 4 } { 5 6 } ]\r
+[ 1 2 3 4 5 6 [ 2array ] 2 3 mnapply ] unit-test\r
+\r
+[ { 1 2 3 } { 4 5 6 } ]\r
+[ 1 2 3 4 5 6 [ 3array ] 3 2 mnapply ] unit-test\r

diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 6c8a0b5fdecf9558538ead28593a5d2904c3bba0..667cff7b8a2aa7a99bd95fbb071dc40cb89fb7bc 100644 (file)
--- a/basis/generalizations/generalizations.factor
+++ b/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 ] ;