basis/concurrency/combinators/combinators.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: concurrency.futures concurrency.count-downs sequences\r
   4 kernel macros fry combinators generalizations ;\r
   5 IN: concurrency.combinators\r
   6 \r
   7 <PRIVATE\r
   8 \r
   9 : (parallel-each) ( n quot -- )\r
  10     [ <count-down> ] dip keep await ; inline\r
  11 \r
  12 PRIVATE>\r
  13 \r
  14 : parallel-each ( seq quot -- )\r
  15     over length [\r
  16         '[ _ curry _ spawn-stage ] each\r
  17     ] (parallel-each) ; inline\r
  18 \r
  19 : 2parallel-each ( seq1 seq2 quot -- )\r
  20     2over min-length [\r
  21         '[ _ 2curry _ spawn-stage ] 2each\r
  22     ] (parallel-each) ; inline\r
  23 \r
  24 : parallel-filter ( seq quot -- newseq )\r
  25     over [ pusher [ parallel-each ] dip ] dip like ; inline\r
  26 \r
  27 <PRIVATE\r
  28 \r
  29 : [future] ( quot -- quot' ) '[ _ curry future ] ; inline\r
  30 \r
  31 : future-values dup [ ?future ] change-each ; inline\r
  32 \r
  33 PRIVATE>\r
  34 \r
  35 : parallel-map ( seq quot -- newseq )\r
  36     [future] map future-values ; inline\r
  37 \r
  38 : 2parallel-map ( seq1 seq2 quot -- newseq )\r
  39     '[ _ 2curry future ] 2map future-values ;\r
  40 \r
  41 <PRIVATE\r
  42 \r
  43 : (parallel-spread) ( n -- spread-array )\r
  44     [ ?future ] <repetition> ; inline\r
  45 \r
  46 : (parallel-cleave) ( quots -- quot-array spread-array )\r
  47     [ [future] ] map dup length (parallel-spread) ; inline\r
  48 \r
  49 PRIVATE>\r
  50 \r
  51 MACRO: parallel-cleave ( quots -- )\r
  52     (parallel-cleave) '[ _ cleave _ spread ] ;\r
  53 \r
  54 MACRO: parallel-spread ( quots -- )\r
  55     (parallel-cleave) '[ _ spread _ spread ] ;\r
  56 \r
  57 MACRO: parallel-napply ( quot n -- )\r
  58     [ [future] ] dip dup (parallel-spread) '[ _ _ napply _ spread ] ;\r