factor/basis/combinators/short-circuit/short-circuit.factor

56 lines
1.4 KiB
Factor
Raw Normal View History

USING: kernel combinators quotations arrays sequences assocs
generalizations macros fry math ;
2008-06-24 09:35:06 -04:00
IN: combinators.short-circuit
<PRIVATE
MACRO: keeping ( n quot -- quot' )
swap dup 1 +
'[ _ _ nkeep _ nrot ] ;
PRIVATE>
MACRO: n&& ( quots n -- quot )
[
[ [ f ] ] 2dip swap [
[ '[ drop _ _ keeping dup not ] ]
[ drop '[ drop _ ndrop f ] ]
2bi 2array
] with map
] [ '[ _ nnip ] suffix 1array ] bi
2008-11-21 05:36:18 -05:00
[ cond ] 3append ;
2008-11-21 05:00:28 -05:00
<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-&& ;
2008-11-21 05:00:28 -05:00
MACRO: n|| ( quots n -- quot )
[
[ [ f ] ] 2dip swap [
[ '[ drop _ _ keeping dup ] ]
[ drop '[ _ nnip ] ]
2bi 2array
] with map
] [ '[ drop _ ndrop t ] [ f ] 2array suffix 1array ] bi
2008-11-21 05:36:18 -05:00
[ cond ] 3append ;
2008-11-21 05:00:28 -05:00
<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-|| ;