From 1e1646a6913eb045d4aaed7e5aa89e5e77bfdb89 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 3 Dec 2014 12:03:04 -0800
Subject: [PATCH] combinators.extras: adding swap-when.

---
 extra/combinators/extras/extras-tests.factor | 3 +++
 extra/combinators/extras/extras.factor       | 3 +++
 2 files changed, 6 insertions(+)

diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor
index 71b773ef99..053812a6bd 100644
--- a/extra/combinators/extras/extras-tests.factor
+++ b/extra/combinators/extras/extras-tests.factor
@@ -29,3 +29,6 @@ IN: combinators.extras.tests
 { 2 5 } [ 1 2 3 4 5 6 [ - - ] 3bi@ ] unit-test
 
 { 3 1 } [ 1 2 [ + ] keepd ] unit-test
+
+[ "1" "123" ] [ "1" "123" [ length ] [ > ] swap-when ] unit-test
+[ "123" "1" ] [ "1" "123" [ length ] [ < ] swap-when ] unit-test
diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
index 81e49b89f3..c30788fbbe 100644
--- a/extra/combinators/extras/extras.factor
+++ b/extra/combinators/extras/extras.factor
@@ -54,3 +54,6 @@ MACRO: smart-plox ( true -- )
         _ nano-count { 0 } 2dup first-unsafe _ + >=
         [ 0 swap set-nth-unsafe call ] [ 3drop ] if
     ] ; inline
+
+: swap-when ( x y quot: ( x -- n ) quot: ( n n -- ? ) -- x' y' )
+    '[ _ _ 2dup _ bi@ @ [ swap ] when ] call ; inline