steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2009-07-18 06:38:34 -05:00
parent 4ee1f68e30
commit 4191deb525
2 changed files with 37 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
basis/combinators/short-circuit/short-circuit-tests.factor
View File

@ -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

29
basis/combinators/short-circuit/short-circuit.factor
View File

@ -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-|| ;