Add nsum, nspread and nweave to generalizations

basis/generalizations/generalizations-docs.factor

@@ -30,6 +30,10 @@ HELP: narray
 
 { nsequence narray } related-words
 
+HELP: nsum
+{ $values { "n" integer } }
+{ $description "Adds the top " { $snippet "n" } " stack values." } ;
+
 HELP: firstn
 { $values { "n" integer } }
 { $description "A generalization of " { $link first } ", "
@@ -238,6 +242,11 @@ HELP: ncleave
     }
 } ;
 
+HELP: nspread
+{ $values { "quots" "a sequence of quotations" } { "n" integer } }
+{ $description "A generalization of " { $link spread } " that can work for any quotation arity."
+} ;
+
 HELP: mnswap
 { $values { "m" integer } { "n" integer } }
 { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
@@ -250,6 +259,17 @@ HELP: mnswap
     }
 } ;
 
+HELP: nweave
+{ $values { "n" integer } }
+{ $description "Copies the top " { $snippet "n" } " stack elements underneath each one of the " { $snippet "n" } " elements below." }
+{ $examples
+  { $example
+    "USING: arrays kernel generalizations prettyprint ;"
+    "\"e1\" \"e2\" \"o1\" \"o2\" 2 nweave [ 3array ] 3dip 3array 2array ."
+    "{ { \"e1\" \"o1\" \"o2\" } { \"e2\" \"o1\" \"o2\" } }"
+  }
+} ;
+
 HELP: n*quot
 { $values
      { "n" integer } { "seq" sequence }
@@ -299,18 +319,14 @@ HELP: ntuck
 }
 { $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ;
 
-ARTICLE: "generalizations" "Generalized shuffle words and combinators"
+ARTICLE: "sequence-generalizations" "Generalized sequence operations"
-"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
-"macros where the arity of the input quotations depends on an "
-"input parameter."
-$nl
-"Generalized sequence operations:"
 { $subsection narray }
 { $subsection nsequence }
 { $subsection firstn }
 { $subsection nappend }
-{ $subsection nappend-as }
+{ $subsection nappend-as } ;
-"Generated stack shuffle operations:"
+
+ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
 { $subsection ndup }
 { $subsection npick }
 { $subsection nrot }
@@ -319,14 +335,28 @@ $nl
 { $subsection ndrop }
 { $subsection ntuck }
 { $subsection mnswap }
-"Generalized combinators:"
+{ $subsection nweave } ;
+
+ARTICLE: "combinator-generalizations" "Generalized combinators"
 { $subsection ndip }
 { $subsection nslip }
 { $subsection nkeep }
 { $subsection napply }
 { $subsection ncleave }
-"Generalized quotation construction:"
+{ $subsection nspread } ;
+
+ARTICLE: "other-generalizations" "Additional generalizations"
 { $subsection ncurry } 
-{ $subsection nwith } ;
+{ $subsection nwith }
+{ $subsection nsum } ;
+
+ARTICLE: "generalizations" "Generalized shuffle words and combinators"
+"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
+"macros where the arity of the input quotations depends on an "
+"input parameter."
+{ $subsection "sequence-generalizations" }
+{ $subsection "shuffle-generalizations" }
+{ $subsection "combinator-generalizations" }
+{ $subsection "other-generalizations" } ;
 
 ABOUT: "generalizations"

basis/generalizations/generalizations-tests.factor

@@ -53,3 +53,12 @@ IN: generalizations.tests
 
 [ 4 nappend ] must-infer
 [ 4 { } nappend-as ] must-infer
+
+[ 17 ] [ 3 1 3 3 7 5 nsum ] unit-test
+{ 4 1 } [ 4 nsum ] must-infer-as
+
+[ "e1" "o1" "o2" "e2" "o1" "o2" ] [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test
+{ 3 5 } [ 2 nweave ] must-infer-as
+
+[ { 0 1 2 } { 3 5 4 } { 7 8 6 } ]
+[ 9 [ ] each { [ 3array ] [ swap 3array ] [ rot 3array ] } 3 nspread ] unit-test

basis/generalizations/generalizations.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
+! Copyright (C) 2007, 2009 Chris Double, Doug Coleman, Eduardo
 ! Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private math combinators
@@ -23,6 +23,9 @@ MACRO: nsequence ( n seq -- )
 MACRO: narray ( n -- )
     '[ _ { } nsequence ] ;
 
+MACRO: nsum ( n -- )
+    1- [ + ] n*quot ;
+
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
         [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
@@ -70,11 +73,23 @@ MACRO: ncleave ( quots n -- )
     [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
     compose ;
 
+MACRO: nspread ( quots n -- )
+    over empty? [ 2drop [ ] ] [
+        [ [ but-last ] dip ]
+        [ [ peek ] dip ] 2bi
+        swap
+        '[ [ _ _ nspread ] _ ndip @ ]
+    ] if ;
+
 MACRO: napply ( quot n -- )
     swap <repetition> spread>quot ;
 
 MACRO: mnswap ( m n -- )
-    1+ '[ _ -nrot ] <repetition> spread>quot ;
+    1+ '[ _ -nrot ] swap '[ _ _ napply ] ;
+
+MACRO: nweave ( n -- )
+    [ dup <reversed> [ '[ _ _ mnswap ] ] with map ] keep
+    '[ _ _ ncleave ] ;
 
 : nappend-as ( n exemplar -- seq )
     [ narray concat ] dip like ; inline