From f721105993996f9bfc86cab893cbf2dd774b3216 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 20 Oct 2008 01:58:17 -0500
Subject: [PATCH] Add 3dip

---
 core/kernel/kernel-docs.factor | 9 +++++++++
 core/kernel/kernel.factor      | 2 ++
 2 files changed, 11 insertions(+)

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 786919bb68..61e10a9c00 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -621,6 +621,14 @@ HELP: 2dip
     { $code "[ foo bar ] 2dip" }
 } ;
 
+HELP: 3dip
+{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quot" quotation } }
+{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } ", " { $snippet "obj2" } " and " { $snippet "obj3" } " hidden on the retain stack." }
+{ $notes "The following are equivalent:"
+    { $code ">r >r >r foo bar r> r> r>" }
+    { $code "[ foo bar ] 3dip" }
+} ;
+
 HELP: while
 { $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
 { $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "body" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
@@ -815,6 +823,7 @@ ARTICLE: "slip-keep-combinators" "The dip, slip and keep combinators"
 "The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
 { $subsection dip }
 { $subsection 2dip }
+{ $subsection 3dip }
 "The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:"
 { $subsection slip }
 { $subsection 2slip }
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 55ed67e0fa..1402b4edf2 100644
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -59,6 +59,8 @@ DEFER: if
 
 : 2dip ( obj1 obj2 quot -- obj1 obj2 ) -rot 2slip ; inline
 
+: 3dip ( obj1 obj2 obj3 quot -- obj1 obj2 obj3 ) -roll 3slip ; inline
+
 ! Keepers
 : keep ( x quot -- x ) over slip ; inline