From d3db7e0225547fffa60d21be4cffde7238d7b115 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Jan 2010 13:47:06 -0600
Subject: [PATCH] Add mnapply, smart-apply.  Docs incoming soon

---
 basis/combinators/smart/smart-tests.factor         | 6 +++++-
 basis/combinators/smart/smart.factor               | 3 +++
 basis/generalizations/generalizations-tests.factor | 5 +++++
 basis/generalizations/generalizations.factor       | 4 ++++
 4 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor
index afafd174d3..11624dcf10 100644
--- 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 05185fec2e..3ad5b6c7ee 100644
--- 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 0c35f15714..84b6565de1 100644
--- 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*
 ] 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
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 6c8a0b5fde..667cff7b8a 100644
--- 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 ] ;