From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 6 Aug 2022 16:49:29 +0000 (-0700)
Subject: combinators.extras: adding plox-if
X-Git-Tag: 0.99~1191
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=a517d91a08c09d6083bca772ed2a8d2f22efe8bc

combinators.extras: adding plox-if
---

diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor
index 0f70125a27..b700de0dc4 100644
--- a/extra/combinators/extras/extras-tests.factor
+++ b/extra/combinators/extras/extras-tests.factor
@@ -187,3 +187,8 @@ IN: combinators.extras.tests
 { 103 203 { { 1 1 } { 2 2 } { 3 3 } } }
 [ 100 200 { { 1 1 } { 2 2 } { 3 3 } } [ [ 1 + ] bi@ ] 2temp2d assoc-map ] unit-test
 
+{ 10 } [ 5 [ 2 * ] plox ] unit-test
+{ f } [ f [ 2 * ] plox ] unit-test
+
+{ 12 } [ 12 [ odd? ] [ 2/ ] plox-if ] unit-test
+{ 6 } [ 13 [ odd? ] [ 2/ ] plox-if ] unit-test
diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
index ec0da1bfc1..600716db5a 100644
--- a/extra/combinators/extras/extras.factor
+++ b/extra/combinators/extras/extras.factor
@@ -58,6 +58,9 @@ MACRO: cleave-array ( quots -- quot )
 : plox ( ... x/f quot: ( ... x -- ... y ) -- ... y/f )
     dupd when ; inline
 
+: plox-if ( ... x quot: ( ... x -- ... ? ) quot: ( ... x -- ... y ) -- ... y/f )
+    [ keep swap ] dip when ; inline
+
 MACRO: smart-plox ( true -- quot )
     [ inputs [ 1 - [ and ] n*quot ] keep ] keep swap
     '[ _ _ [ _ ndrop f ] smart-if ] ;