combinators.short-circuit: fix unoptimized behavior to match optimized behavior,...

diff --git a/basis/combinators/short-circuit/short-circuit-tests.factor b/basis/combinators/short-circuit/short-circuit-tests.factor
index e392d67d2a6df515bf50c35bcae1070cf2bb3d54..b2bcb2a60f7473cd49894a8459a57106a11daa6d 100644 (file)
--- 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
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: must-be-t ( in -- ) [ t ] swap unit-test ;
-: must-be-f ( in -- ) [ f ] swap 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
-
-[       { [ 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
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+[ 3 ] [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test
+[ 5 ] [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& ] unit-test
+[ 30 ] [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& ] unit-test
 
-[ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| "factor" = ] must-be-t
+[ f ] [ { [ 1 ] [ f ] [ 3 ] } 0&& ] unit-test
+[ f ] [ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] unit-test
+[ f ] [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& ] unit-test
 
-[ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| 11 = ]       must-be-t
+[ "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
 
-[ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| 30 = ]  must-be-t
+: compiled-&& ( a -- ? ) { [ 0 > ] [ even? ] [ 2 + ] } 1&& ;
 
-[ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] must-be-f
+[ f ] [ 3 compiled-&& ] unit-test
+[ 4 ] [ 2 compiled-&& ] unit-test
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+: 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 aff25efa96b7111bf82c868e653992b7528b9f27..a625a462afc56466470d4da7ff42e35da83ee9e1 100644 (file)
--- 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? ;
+<PRIVATE
+
+: unoptimized-&& ( quots quot -- ? )
+    [ [ call dup ] ] dip call [ nip ] prepose [ f ] 2dip all? swap and ; inline
+
+PRIVATE>
+
+: 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? ;
+<PRIVATE
+
+: unoptimized-|| ( quots quot -- ? )
+    [ [ call ] ] dip call map-find drop ; inline
+
+PRIVATE>
 
+: 0|| ( quots -- ? ) [ ] unoptimized-|| ;
+: 1|| ( obj quots -- ? ) [ with ] unoptimized-|| ;
+: 2|| ( obj1 obj2 quots -- ? ) [ with with ] unoptimized-|| ;
+: 3|| ( obj1 obj2 obj3 quots -- ? ) [ with with with ] unoptimized-|| ;