Add ncleave combinator to generalizations

diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index 2380f5614d784cfadd0b97ee0b4c057adaea9452..3979e0518a413a2a50cb5b04956db2d3b2b9dd80 100644 (file)
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -1,5 +1,5 @@
 USING: help.syntax help.markup kernel sequences quotations\r
-math arrays ;\r
+math arrays combinators ;\r
 IN: generalizations\r
 \r
 HELP: nsequence\r
@@ -234,6 +234,18 @@ HELP: napply
     }\r
 } ;\r
 \r
+HELP: ncleave\r
+{ $values { "quots" "a sequence of quotations" } { "n" integer } }\r
+{ $description "A generalization of " { $link cleave } " and " { $link 2cleave } " that can work for any quotation arity."\r
+} \r
+{ $examples\r
+  "Some core words expressed in terms of " { $link ncleave } ":"\r
+    { $table\r
+        { { $link cleave } { $snippet "1 ncleave" } }\r
+        { { $link 2cleave } { $snippet "2 ncleave" } }\r
+    }\r
+} ;\r
+\r
 HELP: mnswap\r
 { $values { "m" integer } { "n" integer } }\r
 { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }\r
@@ -269,6 +281,7 @@ $nl
 { $subsection nslip }\r
 { $subsection nkeep }\r
 { $subsection napply }\r
+{ $subsection ncleave }\r
 "Generalized quotation construction:"\r
 { $subsection ncurry } \r
 { $subsection nwith } ;\r

diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 3c24d20c8a15b24ecb376c8481f13754f79804e4..ae7437b346b8cd23795da57944a525856ee58862 100644 (file)
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -69,6 +69,10 @@ MACRO: ncurry ( n -- )
 MACRO: nwith ( n -- )
     [ with ] n*quot ;
 
+MACRO: ncleave ( quots n -- )
+    [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
+    compose ;
+
 MACRO: napply ( n -- )
     2 [a,b]
     [ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ]