make a couple words private, use ERROR: instead of throwing strings
parent
8da5f3a82a
commit
f7c322f83a
|
@ -4,8 +4,10 @@ USING: concurrency.futures concurrency.count-downs sequences
|
||||||
kernel ;
|
kernel ;
|
||||||
IN: concurrency.combinators
|
IN: concurrency.combinators
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
: (parallel-each) ( n quot -- )
|
: (parallel-each) ( n quot -- )
|
||||||
>r <count-down> r> keep await ; inline
|
>r <count-down> r> keep await ; inline
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: parallel-each ( seq quot -- )
|
: parallel-each ( seq quot -- )
|
||||||
over length [
|
over length [
|
||||||
|
@ -20,7 +22,9 @@ IN: concurrency.combinators
|
||||||
: parallel-filter ( seq quot -- newseq )
|
: parallel-filter ( seq quot -- newseq )
|
||||||
over >r pusher >r each r> r> like ; inline
|
over >r pusher >r each r> r> like ; inline
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
: future-values dup [ ?future ] change-each ; inline
|
: future-values dup [ ?future ] change-each ; inline
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: parallel-map ( seq quot -- newseq )
|
: parallel-map ( seq quot -- newseq )
|
||||||
[ curry future ] curry map future-values ;
|
[ curry future ] curry map future-values ;
|
||||||
|
|
|
@ -11,14 +11,18 @@ TUPLE: count-down n promise ;
|
||||||
: count-down-check ( count-down -- )
|
: count-down-check ( count-down -- )
|
||||||
dup n>> zero? [ t swap promise>> fulfill ] [ drop ] if ;
|
dup n>> zero? [ t swap promise>> fulfill ] [ drop ] if ;
|
||||||
|
|
||||||
|
ERROR: invalid-count-down-count count ;
|
||||||
|
|
||||||
: <count-down> ( n -- count-down )
|
: <count-down> ( n -- count-down )
|
||||||
dup 0 < [ "Invalid count for count down" throw ] when
|
dup 0 < [ invalid-count-down-count ] when
|
||||||
<promise> \ count-down boa
|
<promise> \ count-down boa
|
||||||
dup count-down-check ;
|
dup count-down-check ;
|
||||||
|
|
||||||
|
ERROR: count-down-already-done ;
|
||||||
|
|
||||||
: count-down ( count-down -- )
|
: count-down ( count-down -- )
|
||||||
dup n>> dup zero?
|
dup n>> dup zero?
|
||||||
[ "Count down already done" throw ]
|
[ count-down-already-done ]
|
||||||
[ 1- >>n count-down-check ] if ;
|
[ 1- >>n count-down-check ] if ;
|
||||||
|
|
||||||
: await-timeout ( count-down timeout -- )
|
: await-timeout ( count-down timeout -- )
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
! Concurrency library for Factor, based on Erlang/Termite style
|
! Concurrency library for Factor, based on Erlang/Termite style
|
||||||
! concurrency.
|
! concurrency.
|
||||||
USING: kernel threads concurrency.mailboxes continuations
|
USING: kernel threads concurrency.mailboxes continuations
|
||||||
namespaces assocs random accessors ;
|
namespaces assocs random accessors summary ;
|
||||||
IN: concurrency.messaging
|
IN: concurrency.messaging
|
||||||
|
|
||||||
GENERIC: send ( message thread -- )
|
GENERIC: send ( message thread -- )
|
||||||
|
@ -52,9 +52,14 @@ TUPLE: reply data tag ;
|
||||||
[ >r tag>> r> tag>> = ]
|
[ >r tag>> r> tag>> = ]
|
||||||
[ 2drop f ] if ;
|
[ 2drop f ] if ;
|
||||||
|
|
||||||
|
ERROR: cannot-send-synchronous-to-self message thread ;
|
||||||
|
|
||||||
|
M: cannot-send-synchronous-to-self summary
|
||||||
|
drop "Cannot synchronous send to myself" ;
|
||||||
|
|
||||||
: send-synchronous ( message thread -- reply )
|
: send-synchronous ( message thread -- reply )
|
||||||
dup self eq? [
|
dup self eq? [
|
||||||
"Cannot synchronous send to myself" throw
|
cannot-send-synchronous-to-self
|
||||||
] [
|
] [
|
||||||
>r <synchronous> dup r> send
|
>r <synchronous> dup r> send
|
||||||
[ synchronous-reply? ] curry receive-if
|
[ synchronous-reply? ] curry receive-if
|
||||||
|
|
|
@ -11,9 +11,10 @@ TUPLE: promise mailbox ;
|
||||||
: promise-fulfilled? ( promise -- ? )
|
: promise-fulfilled? ( promise -- ? )
|
||||||
mailbox>> mailbox-empty? not ;
|
mailbox>> mailbox-empty? not ;
|
||||||
|
|
||||||
|
ERROR: promise-already-fulfilled promise ;
|
||||||
: fulfill ( value promise -- )
|
: fulfill ( value promise -- )
|
||||||
dup promise-fulfilled? [
|
dup promise-fulfilled? [
|
||||||
"Promise already fulfilled" throw
|
promise-already-fulfilled
|
||||||
] [
|
] [
|
||||||
mailbox>> mailbox-put
|
mailbox>> mailbox-put
|
||||||
] if ;
|
] if ;
|
||||||
|
|
Loading…
Reference in New Issue