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

48 lines
1.3 KiB
Factor
Raw Normal View History

USING: kernel combinators quotations arrays sequences assocs
2008-11-21 05:00:28 -05:00
locals generalizations macros fry ;
2008-06-24 09:35:06 -04:00
IN: combinators.short-circuit
2008-11-21 05:00:28 -05:00
MACRO:: n&& ( quots n -- quot )
[ f ] quots [| q |
n
[ q '[ drop _ ndup @ dup not ] ]
[ '[ drop _ ndrop f ] ]
bi 2array
] map
n '[ _ nnip ] suffix 1array
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 ] quots [| q |
n
[ q '[ drop _ ndup @ dup ] ]
[ '[ _ nnip ] ]
bi 2array
] map
n '[ drop _ ndrop t ] [ f ] 2array suffix 1array
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-|| ;