diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 2977d02c6f..7cf15394ef 100755 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -169,7 +169,7 @@ HELP: rethrow HELP: throw-restarts { $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 "Try invoking one of the two restarts which are offered after the below code throws an error:" { $code diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index b46439b583..a8e0bc6eeb 100755 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -264,26 +264,31 @@ PRIVATE> #! so the server continuation gets its new self updated. 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 ) - #! Spawn a process to call the quotation and immediately return - #! a 'future' on the stack. The future can later be queried with - #! ?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 ). - [ + #! Spawn a process to call the quotation and immediately return. + \ future construct-empty [ [ - t - ] compose - ] spawn drop - [ self send ] compose spawn ; - -: ?future ( future -- result ) + >r [ t 2array ] compose [ f 2array ] recover r> + notify-future + ] 2curry spawn drop + ] keep ; + + : ?future ( future -- result ) #! Block the process until the future has completed and then #! place the result on the stack. Return the result #! 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 ) #! Spawn a process to apply quot to each element of seq,