From a517d91a08c09d6083bca772ed2a8d2f22efe8bc Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 6 Aug 2022 09:49:29 -0700 Subject: [PATCH] combinators.extras: adding plox-if --- extra/combinators/extras/extras-tests.factor | 5 +++++ extra/combinators/extras/extras.factor | 3 +++ 2 files changed, 8 insertions(+) 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 ] ; -- 2.34.1