Add parallel-cleave, parallel-spread, parallel-napply combinators
parent
f3911ea09a
commit
cdf7436667
|
@ -27,11 +27,17 @@ HELP: parallel-filter
|
||||||
{ $errors "Throws an error if one of the iterations throws an error." } ;
|
{ $errors "Throws an error if one of the iterations throws an error." } ;
|
||||||
|
|
||||||
ARTICLE: "concurrency.combinators" "Concurrent combinators"
|
ARTICLE: "concurrency.combinators" "Concurrent combinators"
|
||||||
"The " { $vocab-link "concurrency.combinators" } " vocabulary provides concurrent variants of " { $link each } ", " { $link map } " and " { $link filter } ":"
|
"The " { $vocab-link "concurrency.combinators" } " vocabulary provides concurrent variants of various combinators."
|
||||||
|
$nl
|
||||||
|
"Concurrent sequence combinators:"
|
||||||
{ $subsection parallel-each }
|
{ $subsection parallel-each }
|
||||||
{ $subsection 2parallel-each }
|
{ $subsection 2parallel-each }
|
||||||
{ $subsection parallel-map }
|
{ $subsection parallel-map }
|
||||||
{ $subsection 2parallel-map }
|
{ $subsection 2parallel-map }
|
||||||
{ $subsection parallel-filter } ;
|
{ $subsection parallel-filter }
|
||||||
|
"Concurrent cleave combinators:"
|
||||||
|
{ $subsection parallel-cleave }
|
||||||
|
{ $subsection parallel-spread }
|
||||||
|
{ $subsection parallel-napply } ;
|
||||||
|
|
||||||
ABOUT: "concurrency.combinators"
|
ABOUT: "concurrency.combinators"
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
IN: concurrency.combinators.tests
|
IN: concurrency.combinators.tests
|
||||||
USING: concurrency.combinators tools.test random kernel math
|
USING: concurrency.combinators tools.test random kernel math
|
||||||
concurrency.mailboxes threads sequences accessors arrays ;
|
concurrency.mailboxes threads sequences accessors arrays
|
||||||
|
math.parser ;
|
||||||
|
|
||||||
[ [ drop ] parallel-each ] must-infer
|
[ [ drop ] parallel-each ] must-infer
|
||||||
{ 2 0 } [ [ 2drop ] 2parallel-each ] must-infer-as
|
{ 2 0 } [ [ 2drop ] 2parallel-each ] must-infer-as
|
||||||
|
@ -45,3 +46,10 @@ concurrency.mailboxes threads sequences accessors arrays ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ { f } [ "OOPS" throw ] parallel-each ] must-fail
|
[ { f } [ "OOPS" throw ] parallel-each ] must-fail
|
||||||
|
|
||||||
|
[ "1a" "4b" "3c" ] [
|
||||||
|
2
|
||||||
|
{ [ 1- ] [ sq ] [ 1+ ] } parallel-cleave
|
||||||
|
[ number>string ] 3 parallel-napply
|
||||||
|
{ [ "a" append ] [ "b" append ] [ "c" append ] } parallel-spread
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -1,34 +1,58 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: concurrency.futures concurrency.count-downs sequences
|
USING: concurrency.futures concurrency.count-downs sequences
|
||||||
kernel ;
|
kernel macros fry combinators generalizations ;
|
||||||
IN: concurrency.combinators
|
IN: concurrency.combinators
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (parallel-each) ( n quot -- )
|
: (parallel-each) ( n quot -- )
|
||||||
>r <count-down> r> keep await ; inline
|
[ <count-down> ] dip keep await ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: parallel-each ( seq quot -- )
|
: parallel-each ( seq quot -- )
|
||||||
over length [
|
over length [
|
||||||
[ >r curry r> spawn-stage ] 2curry each
|
'[ _ curry _ spawn-stage ] each
|
||||||
] (parallel-each) ; inline
|
] (parallel-each) ; inline
|
||||||
|
|
||||||
: 2parallel-each ( seq1 seq2 quot -- )
|
: 2parallel-each ( seq1 seq2 quot -- )
|
||||||
2over min-length [
|
2over min-length [
|
||||||
[ >r 2curry r> spawn-stage ] 2curry 2each
|
'[ _ 2curry _ spawn-stage ] 2each
|
||||||
] (parallel-each) ; inline
|
] (parallel-each) ; inline
|
||||||
|
|
||||||
: parallel-filter ( seq quot -- newseq )
|
: parallel-filter ( seq quot -- newseq )
|
||||||
over >r pusher >r each r> r> like ; inline
|
over [ pusher [ each ] dip ] dip like ; inline
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
: [future] ( quot -- quot' ) '[ _ curry future ] ; inline
|
||||||
|
|
||||||
: future-values dup [ ?future ] change-each ; inline
|
: future-values dup [ ?future ] change-each ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: parallel-map ( seq quot -- newseq )
|
: parallel-map ( seq quot -- newseq )
|
||||||
[ curry future ] curry map future-values ;
|
[future] map future-values ; inline
|
||||||
inline
|
|
||||||
|
|
||||||
: 2parallel-map ( seq1 seq2 quot -- newseq )
|
: 2parallel-map ( seq1 seq2 quot -- newseq )
|
||||||
[ 2curry future ] curry 2map future-values ;
|
'[ _ 2curry future ] 2map future-values ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: (parallel-spread) ( n -- spread-array )
|
||||||
|
[ ?future ] <repetition> ; inline
|
||||||
|
|
||||||
|
: (parallel-cleave) ( quots -- quot-array spread-array )
|
||||||
|
[ [future] ] map dup length (parallel-spread) ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
MACRO: parallel-cleave ( quots -- )
|
||||||
|
(parallel-cleave) '[ _ cleave _ spread ] ;
|
||||||
|
|
||||||
|
MACRO: parallel-spread ( quots -- )
|
||||||
|
(parallel-cleave) '[ _ spread _ spread ] ;
|
||||||
|
|
||||||
|
MACRO: parallel-napply ( quot n -- )
|
||||||
|
[ [future] ] dip dup (parallel-spread) '[ _ _ napply _ spread ] ;
|
||||||
|
|
Loading…
Reference in New Issue