From 4191deb5251b751841031556b25416158676254b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 18 Jul 2009 06:38:34 -0500 Subject: [PATCH] combinators.short-circuit: fix unoptimized behavior to match optimized behavior, improved unit tests --- .../short-circuit/short-circuit-tests.factor | 39 ++++++++----------- .../short-circuit/short-circuit.factor | 29 ++++++++++---- 2 files changed, 37 insertions(+), 31 deletions(-) diff --git a/basis/combinators/short-circuit/short-circuit-tests.factor b/basis/combinators/short-circuit/short-circuit-tests.factor index e392d67d2a..b2bcb2a60f 100644 --- a/basis/combinators/short-circuit/short-circuit-tests.factor +++ b/basis/combinators/short-circuit/short-circuit-tests.factor @@ -1,32 +1,25 @@ - USING: kernel math tools.test combinators.short-circuit ; - IN: combinators.short-circuit.tests -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +[ 3 ] [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test +[ 5 ] [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& ] unit-test +[ 30 ] [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& ] unit-test -: must-be-t ( in -- ) [ t ] swap unit-test ; -: must-be-f ( in -- ) [ f ] swap unit-test ; +[ f ] [ { [ 1 ] [ f ] [ 3 ] } 0&& ] unit-test +[ f ] [ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] unit-test +[ f ] [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& ] unit-test -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +[ "factor" ] [ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| ] unit-test +[ 11 ] [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| ] unit-test +[ 30 ] [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| ] unit-test +[ f ] [ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] unit-test -[ { [ 1 ] [ 2 ] [ 3 ] } 0&& 3 = ] must-be-t -[ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& 5 = ] must-be-t -[ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& 30 = ] must-be-t +: compiled-&& ( a -- ? ) { [ 0 > ] [ even? ] [ 2 + ] } 1&& ; -[ { [ 1 ] [ f ] [ 3 ] } 0&& 3 = ] must-be-f -[ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] must-be-f -[ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& 30 = ] must-be-f +[ f ] [ 3 compiled-&& ] unit-test +[ 4 ] [ 2 compiled-&& ] unit-test -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| "factor" = ] must-be-t - -[ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| 11 = ] must-be-t - -[ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| 30 = ] must-be-t - -[ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] must-be-f - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: compiled-|| ( a b -- ? ) { [ + odd? ] [ + 100 > ] [ + ] } 2|| ; +[ 30 ] [ 10 20 compiled-|| ] unit-test +[ 2 ] [ 1 1 compiled-|| ] unit-test \ No newline at end of file diff --git a/basis/combinators/short-circuit/short-circuit.factor b/basis/combinators/short-circuit/short-circuit.factor index aff25efa96..a625a462af 100644 --- a/basis/combinators/short-circuit/short-circuit.factor +++ b/basis/combinators/short-circuit/short-circuit.factor @@ -12,10 +12,17 @@ MACRO:: n&& ( quots n -- quot ) n '[ _ nnip ] suffix 1array [ cond ] 3append ; -: 0&& ( quots -- ? ) [ call ] all? ; -: 1&& ( obj quots -- ? ) [ call ] with all? ; -: 2&& ( obj quots -- ? ) [ call ] with with all? ; -: 3&& ( obj quots -- ? ) [ call ] with with with all? ; + + +: 0&& ( quots -- ? ) [ ] unoptimized-&& ; +: 1&& ( obj quots -- ? ) [ with ] unoptimized-&& ; +: 2&& ( obj1 obj2 quots -- ? ) [ with with ] unoptimized-&& ; +: 3&& ( obj1 obj2 obj3 quots -- ? ) [ with with with ] unoptimized-&& ; MACRO:: n|| ( quots n -- quot ) [ f ] quots [| q | @@ -27,8 +34,14 @@ MACRO:: n|| ( quots n -- quot ) n '[ drop _ ndrop t ] [ f ] 2array suffix 1array [ cond ] 3append ; -: 0|| ( quots -- ? ) [ call ] any? ; -: 1|| ( obj quots -- ? ) [ call ] with any? ; -: 2|| ( obj quots -- ? ) [ call ] with with any? ; -: 3|| ( obj quots -- ? ) [ call ] with with with any? ; + + +: 0|| ( quots -- ? ) [ ] unoptimized-|| ; +: 1|| ( obj quots -- ? ) [ with ] unoptimized-|| ; +: 2|| ( obj1 obj2 quots -- ? ) [ with with ] unoptimized-|| ; +: 3|| ( obj1 obj2 obj3 quots -- ? ) [ with with with ] unoptimized-|| ;