Demonstrate smart-if and smart-if* combinators

diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor
index 11624dcf1046d715b5ee27c144829977beb215e9..ec05bd67c3bc600cc7cec41b220282c67194dea1 100644 (file)
--- a/basis/combinators/smart/smart-tests.factor
+++ b/basis/combinators/smart/smart-tests.factor
@@ -63,3 +63,13 @@ IN: combinators.smart.tests
 
 [ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 3 smart-apply ] unit-test
 [ { 1 2 3 } { 4 5 6 } ] [ 1 2 3 4 5 6 [ 3array ] 2 smart-apply ] unit-test
+
+[ 4 ] [ 2 [ even? ] [ 2 + ] smart-when ] unit-test
+[ 3 ] [ 3 [ even? ] [ 2 + ] smart-when ] unit-test
+[ 4 ] [ 2 [ odd? ] [ 2 + ] smart-unless ] unit-test
+[ 3 ] [ 3 [ odd? ] [ 2 + ] smart-unless ] unit-test
+
+[ 4 ] [ 2 [ even? ] [ 2 + ] smart-when* ] unit-test
+[ ] [ 3 [ even? ] [ 2 + ] smart-when* ] unit-test
+[ 3 ] [ 2 [ odd? ] [ 3 ] smart-unless* ] unit-test
+[ 3 ] [ 3 [ odd? ] [ 5 ] smart-unless* ] unit-test

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index 5576421742708a93423eb02cf612870940d1112d..c4bb35ef4e8b5c0d2c316e99f4d4e456eb892a38 100644 (file)
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -49,8 +49,29 @@ MACRO: preserving ( quot -- )
 MACRO: nullary ( quot -- quot' )
     dup outputs '[ @ _ ndrop ] ;
 
-MACRO: smart-if ( pred true false -- )
+MACRO: dropping ( quot -- quot' )
+    outputs '[ [ _ ndrop ] ] ;
+
+MACRO: balancing ( quot -- quot' )
+    '[ _ [ preserving ] [ dropping ] bi ] ;
+
+MACRO: smart-if ( pred true false -- quot )
     '[ _ preserving _ _ if ] ;
 
-MACRO: smart-apply ( quot n -- )
+MACRO: smart-when ( pred true -- quot )
+    '[ _ _ [ ] smart-if ] ;
+
+MACRO: smart-unless ( pred false -- quot )
+    '[ _ [ ] _ smart-if ] ;
+
+MACRO: smart-if* ( pred true false -- quot )
+    '[ _ balancing _ swap _ compose if ] ;
+
+MACRO: smart-when* ( pred true -- quot )
+    '[ _ _ [ ] smart-if* ] ;
+
+MACRO: smart-unless* ( pred false -- quot )
+    '[ _ [ ] _ smart-if* ] ;
+
+MACRO: smart-apply ( quot n -- quot )
     [ dup inputs ] dip '[ _ _ _ mnapply ] ;