From 474b718337163a1d0a376d210d6538c748bb6a8c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 9 Dec 2008 04:20:20 -0600
Subject: [PATCH] Add ncleave combinator to generalizations

---
 basis/generalizations/generalizations-docs.factor | 15 ++++++++++++++-
 basis/generalizations/generalizations.factor      |  4 ++++
 2 files changed, 18 insertions(+), 1 deletion(-)

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