Merge git://factorcode.org/git/factor

db4
Eduardo Cavazos 2008-02-09 20:23:22 -06:00
commit c7719eb70b
2 changed files with 20 additions and 15 deletions

View File

@ -169,7 +169,7 @@ HELP: rethrow
HELP: throw-restarts HELP: throw-restarts
{ $values { "error" object } { "restarts" "a sequence of " { $snippet "{ string object }" } " pairs" } { "restart" object } } { $values { "error" object } { "restarts" "a sequence of " { $snippet "{ string object }" } " pairs" } { "restart" object } }
{ $description "Throws a restartable error using " { $link throw } ". The " { $snippet "restarts" } " parameter is a sequence of pairs where the first element in each pair is a human-readable description and the second is an arbitrary object. If the error reaches the top-level error handler, the user will be presented with the list of possible restarts, and upon invoking one, execution will continue after the call to " { $link condition } " with the object associated to the chosen restart on the stack." } { $description "Throws a restartable error using " { $link throw } ". The " { $snippet "restarts" } " parameter is a sequence of pairs where the first element in each pair is a human-readable description and the second is an arbitrary object. If the error reaches the top-level error handler, the user will be presented with the list of possible restarts, and upon invoking one, execution will continue after the call to " { $link throw-restarts } " with the object associated to the chosen restart on the stack." }
{ $examples { $examples
"Try invoking one of the two restarts which are offered after the below code throws an error:" "Try invoking one of the two restarts which are offered after the below code throws an error:"
{ $code { $code

View File

@ -264,26 +264,31 @@ 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 status value processes ; 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 \ future construct-empty [
#! ?future. If the quotation has completed the result will be returned.
#! If not, the process will block until the quotation completes.
#! 'quot' must have stack effect ( -- X ).
[
[ [
t >r [ t 2array ] compose [ f 2array ] recover r>
] compose notify-future
] spawn drop ] 2curry spawn drop
[ self send ] compose spawn ; ] 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
] [
dup [ future-processes push stop ] curry callcc0 ?future
] ?if ;
: parallel-map ( seq quot -- newseq ) : parallel-map ( seq quot -- newseq )
#! Spawn a process to apply quot to each element of seq, #! Spawn a process to apply quot to each element of seq,