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

change concurrency library to use new catch usage

cvs
Chris Double 2005-09-21 02:15:29 +00:00
parent 6b4227b022
commit cd32714099
4 changed files with 17 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
contrib/concurrency/concurrency-examples.factor
View File

@ -128,12 +128,12 @@ M: crash-command run-rpc-command ( command -- shutdown? result )
: (robust-rpc-server) ( worker -- ) : (robust-rpc-server) ( worker -- )
[ [
receive over send receive over send
] [ ]
[ catch
"Worker died, Starting a new worker" print [
drop [ handle-rpc-message ] spawn-linked-server "Worker died, Starting a new worker" print
] when drop [ handle-rpc-message ] spawn-linked-server
] catch ] when
(robust-rpc-server) ; (robust-rpc-server) ;
: robust-rpc-server ( -- process ) : robust-rpc-server ( -- process )

3
contrib/concurrency/concurrency-tests.factor
View File

@ -164,8 +164,7 @@ USING: kernel concurrency concurrency-examples threads vectors
] spawn-link drop ] spawn-link drop
receive receive
] ]
[ catch
] catch
] unit-test ] unit-test
[ 50 ] [ [ 50 ] [

2
contrib/concurrency/concurrency.factor
View File

@ -209,7 +209,7 @@ TUPLE: linked-exception error ;
#! Same as spawn but if the quotation throws an error that #! Same as spawn but if the quotation throws an error that
#! is uncaught, that error gets propogated to the process #! is uncaught, that error gets propogated to the process
#! performing the spawn-link. #! performing the spawn-link.
[ [ [ rethrow-linked ] when* ] catch ] cons [ catch [ rethrow-linked ] when* ] cons
[ in-thread ] self make-linked-process [ with-process ] over slip ; [ in-thread ] self make-linked-process [ with-process ] over slip ;
#! A common operation is to send a message to a process containing #! A common operation is to send a message to a process containing

18
contrib/concurrency/concurrency.html
View File

@ -349,9 +349,9 @@ can catch it:</p>
"This will not print" print "This will not print" print
] spawn-link drop ] spawn-link drop
receive receive
] [ ]
[ "Exception caught." print ] when catch [ "Exception caught." print ] when
] catch</span> </span>
=> "Exception caught." => "Exception caught."
</pre> </pre>
<p>Exceptions are only raised in the parent when the parent does a <p>Exceptions are only raised in the parent when the parent does a
@ -427,12 +427,12 @@ worker:</p>
[ [
#! Forward all messages to worker #! Forward all messages to worker
receive over send receive over send
] [ ]
[ catch
"Worker died, Starting a new worker" print [
drop [ handle-rpc-message ] spawn-linked-server "Worker died, Starting a new worker" print
] when drop [ handle-rpc-message ] spawn-linked-server
] catch ] when
(robust-rpc-server) ; (robust-rpc-server) ;
: robust-rpc-server ( -- process ) : robust-rpc-server ( -- process )