steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix a couple of issues with futures

db4
Slava Pestov 2008-02-08 21:47:35 -06:00
parent 52d91bf0bc
commit 20649302fa
2 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
extra/concurrency/concurrency-tests.factor
View File

@ -112,9 +112,9 @@ SYMBOL: value
! The following unit test blocks forever if the ! The following unit test blocks forever if the
! exception does not propogate. Uncomment when ! exception does not propogate. Uncomment when
! this is fixed (via a timeout). ! this is fixed (via a timeout).
! [ [
! [ "this should propogate" throw ] future ?future [ "this should propogate" throw ] future ?future
! ] must-fail ] must-fail
[ ] [ [ ] [
[ "this should not propogate" throw ] future drop [ "this should not propogate" throw ] future drop
@ -127,4 +127,10 @@ SYMBOL: value
[ f ] [ [ f ] [
[ "testing unregistering on error" throw ] spawn [ "testing unregistering on error" throw ] spawn
100 sleep process-pid get-process 100 sleep process-pid get-process
] unit-test ] unit-test
! Race condition with futures
[ 3 3 ] [
[ 3 ] future
dup ?future swap ?future
] unit-test

30
extra/concurrency/concurrency.factor
View File

@ -264,29 +264,35 @@ PRIVATE>
#! so the server continuation gets its new self updated. #! so the server continuation gets its new self updated.
self swap call ; self swap call ;
TUPLE: future value processes ;
: notify-future ( value future -- )
tuck set-future-value
dup future-processes [ schedule-thread ] each
f swap set-future-processes ;
: future ( quot -- future ) : future ( quot -- future )
#! Spawn a process to call the quotation and immediately return #! Spawn a process to call the quotation and immediately return
#! a 'future' on the stack. The future can later be queried with #! a 'future' on the stack. The future can later be queried with
#! ?future. If the quotation has completed the result will be returned. #! ?future. If the quotation has completed the result will be returned.
#! If not, the process will block until the quotation completes. #! If not, the process will block until the quotation completes.
#! 'quot' must have stack effect ( -- X ). #! 'quot' must have stack effect ( -- X ).
[ self send ] compose spawn ; \ future construct-empty [
[
>r [ t 2array ] compose [ f 2array ] recover r>
notify-future
] 2curry spawn drop
] keep ;
: ?future ( future -- result ) : ?future ( future -- result )
#! Block the process until the future has completed and then #! Block the process until the future has completed and then
#! place the result on the stack. Return the result #! place the result on the stack. Return the result
#! immediately if the future has completed. #! immediately if the future has completed.
process-mailbox mailbox-get ; dup future-value [
first2 [ throw ] unless
: parallel-map ( seq quot -- newseq ) ] [
#! Spawn a process to apply quot to each element of seq, dup [ future-processes push stop ] curry callcc0 ?future
#! joining the results into a sequence at the end. ] ?if ;
[ curry future ] curry map [ ?future ] map ;
: parallel-each ( seq quot -- )
#! Spawn a process to apply quot to each element of seq,
#! and waits for all processes to complete.
[ f ] compose parallel-map drop ;
TUPLE: promise fulfilled? value processes ; TUPLE: promise fulfilled? value processes ;