basis/concurrency/combinators/combinators.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays assocs combinators concurrency.count-downs
   4 concurrency.futures generalizations kernel sequences
   5 sequences.private sequences.product ;
   6 IN: concurrency.combinators
   7
   8 <PRIVATE
   9
  10 : (parallel-each) ( n quot -- )
  11     [ <count-down> ] dip keep await ; inline
  12
  13 PRIVATE>
  14
  15 : parallel-each ( seq quot: ( elt -- ) -- )
  16     over length [
  17         '[ _ curry _ spawn-stage ] each
  18     ] (parallel-each) ; inline
  19
  20 : 2parallel-each ( seq1 seq2 quot: ( elt1 elt2 -- ) -- )
  21     2over min-length [
  22         '[ _ 2curry _ spawn-stage ] 2each
  23     ] (parallel-each) ; inline
  24
  25 : parallel-product-each ( seq quot: ( elt -- ) -- )
  26     [ <product-sequence> ] dip parallel-each ;
  27
  28 : parallel-cartesian-each ( seq1 seq2 quot: ( elt1 elt2 -- ) -- )
  29     [ 2array ] dip [ first2-unsafe ] prepose parallel-product-each ;
  30
  31 : parallel-filter ( seq quot: ( elt -- ? ) -- newseq )
  32     over [ selector [ parallel-each ] dip ] dip like ; inline
  33
  34 <PRIVATE
  35
  36 : [future] ( quot -- quot' ) '[ _ curry future ] ; inline
  37
  38 : future-values ( futures -- futures )
  39     [ ?future ] map! ; inline
  40
  41 PRIVATE>
  42
  43 : parallel-map ( seq quot: ( elt -- newelt ) -- newseq )
  44     [future] map future-values ; inline
  45
  46 : parallel-assoc-map-as ( assoc quot: ( key value -- newkey newvalue ) exemplar -- newassoc )
  47     [
  48         [ 2array ] compose '[ _ 2curry future ] { } assoc>map future-values
  49     ] dip assoc-like ;
  50
  51 : parallel-assoc-map ( assoc quot: ( key value -- newkey newvalue ) -- newassoc )
  52     over parallel-assoc-map-as ;
  53
  54 : 2parallel-map ( seq1 seq2 quot: ( elt1 elt2 -- newelt ) -- newseq )
  55     '[ _ 2curry future ] 2map future-values ;
  56
  57 : parallel-product-map ( seq quot: ( elt -- newelt ) -- newseq )
  58     [ <product-sequence> ] dip parallel-map ;
  59
  60 : parallel-cartesian-map ( seq1 seq2 quot: ( elt1 elt2 -- newelt ) -- newseq )
  61     [ 2array ] dip [ first2-unsafe ] prepose parallel-product-map ;
  62
  63 <PRIVATE
  64
  65 : (parallel-spread) ( n -- spread-array )
  66     [ ?future ] <repetition> ; inline
  67
  68 : (parallel-cleave) ( quots -- quot-array spread-array )
  69     [ [future] ] map dup length (parallel-spread) ; inline
  70
  71 PRIVATE>
  72
  73 MACRO: parallel-cleave ( quots -- quot )
  74     (parallel-cleave) '[ _ cleave _ spread ] ;
  75
  76 MACRO: parallel-spread ( quots -- quot )
  77     (parallel-cleave) '[ _ spread _ spread ] ;
  78
  79 MACRO: parallel-napply ( quot n -- quot )
  80     [ [future] ] dip dup (parallel-spread) '[ _ _ napply _ spread ] ;