diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor index 11624dcf10..ec05bd67c3 100644 --- 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 5576421742..c4bb35ef4e 100644 --- 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 ] ;