Rewrite mnapply to be a combinator instead of a macro. Write nspread* to implement mnapply

basis/combinators/smart/smart.factor

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

basis/generalizations/generalizations-tests.factor

@@ -113,3 +113,12 @@ IN: generalizations.tests
 
 [ { 1 2 3 } { 4 5 6 } ]
 [ 1 2 3 4 5 6 [ 3array ] 3 2 mnapply ] unit-test
+
+[ { 1 2 3 } { 4 5 6 } ]
+[ 1 2 3 4 5 6 [ 3array ] [ 3array ] 3 2 nspread* ] unit-test
+
+[ ]
+[ [ 2array ] 2 0 mnapply ] unit-test
+
+[ ]
+[ 2 0 nspread* ] unit-test

basis/generalizations/generalizations.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private sequences sequences.private math
 combinators macros math.order math.ranges quotations fry effects
-memoize.private ;
+memoize.private arrays ;
 IN: generalizations
 
 <<
@@ -100,10 +100,20 @@ MACRO: nspread ( quots n -- )
 
 MACRO: spread* ( n -- )
     [ [ ] ] [
-        1 swap [a,b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as
+        [1,b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as
         [ call ] compose
     ] if-zero ;
 
+MACRO: nspread* ( m n -- )
+    [ drop [ ] ] [
+        [ * 0 ] [ drop neg ] 2bi
+        <range> rest >array dup length iota <reversed>
+        [
+            '[ [ [ _ ndip ] curry ] _ ndip ]
+        ] 2map dup rest-slice [ [ compose ] compose ] map! drop
+        [ ] concat-as [ call ] compose
+    ] if-zero ;
+
 MACRO: cleave* ( n -- )
     [ [ ] ]
     [ 1 - [ [ [ keep ] curry ] dip compose ] n*quot [ call ] compose ] 
@@ -112,6 +122,9 @@ MACRO: cleave* ( n -- )
 : napply ( quot n -- )
     [ dupn ] [ spread* ] bi ; inline
 
+: mnapply ( quot m n -- )
+    [ nip dupn ] [ nspread* ] 2bi ; inline
+
 : apply-curry ( ...a quot n -- )
     [ [curry] ] dip napply ; inline
 
@@ -124,10 +137,6 @@ 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 ] ;