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

   1 USING: arrays combinators fry generalizations kernel macros
   2 math sequences ;
   3 IN: combinators.short-circuit
   4
   5 <PRIVATE
   6
   7 MACRO: keeping ( n quot -- quot' )
   8     swap dup 1 +
   9     '[ _ _ nkeep _ nrot ] ;
  10
  11 PRIVATE>
  12
  13 MACRO: n&& ( quots n -- quot )
  14     [
  15         [ [ f ] ] 2dip swap [
  16             [ '[ drop _ _ keeping dup not ] ]
  17             [ drop '[ drop _ ndrop f ] ]
  18             2bi 2array
  19         ] with map
  20     ] [ '[ _ nnip ] suffix 1array ] bi
  21     [ cond ] 3append ;
  22
  23 <PRIVATE
  24
  25 : unoptimized-&& ( quots quot -- ? )
  26     [ [ call dup ] ] dip call [ nip ] prepose [ f ] 2dip all? swap and ; inline
  27
  28 PRIVATE>
  29
  30 : 0&& ( quots -- ? ) [ ] unoptimized-&& ;
  31 : 1&& ( obj quots -- ? ) [ with ] unoptimized-&& ;
  32 : 2&& ( obj1 obj2 quots -- ? ) [ 2with ] unoptimized-&& ;
  33 : 3&& ( obj1 obj2 obj3 quots -- ? ) [ 3 nwith ] unoptimized-&& ;
  34
  35 MACRO: n|| ( quots n -- quot )
  36     [
  37         [ [ f ] ] 2dip swap [
  38             [ '[ drop _ _ keeping dup ] ]
  39             [ drop '[ _ nnip ] ]
  40             2bi 2array
  41         ] with map
  42     ] [ '[ drop _ ndrop t ] [ f ] 2array suffix 1array ] bi
  43     [ cond ] 3append ;
  44
  45 <PRIVATE
  46
  47 : unoptimized-|| ( quots quot -- ? )
  48     [ [ call ] ] dip call map-find drop ; inline
  49
  50 PRIVATE>
  51
  52 : 0|| ( quots -- ? ) [ ] unoptimized-|| ;
  53 : 1|| ( obj quots -- ? ) [ with ] unoptimized-|| ;
  54 : 2|| ( obj1 obj2 quots -- ? ) [ 2with ] unoptimized-|| ;
  55 : 3|| ( obj1 obj2 obj3 quots -- ? ) [ 3 nwith ] unoptimized-|| ;