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

Refactor some remote channels code

db4
Chris Double 2009-10-30 14:19:34 +13:00
parent 536a4a3932
commit 628a0ba530
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
basis/channels/remote/remote.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
! Remote Channels ! Remote Channels
USING: kernel init namespaces make assocs arrays random USING: kernel init namespaces assocs arrays random
sequences channels match concurrency.messaging sequences channels match concurrency.messaging
concurrency.distributed threads accessors ; concurrency.distributed threads accessors ;
IN: channels.remote IN: channels.remote
@ -27,39 +27,45 @@ PRIVATE>
MATCH-VARS: ?from ?tag ?id ?value ; MATCH-VARS: ?from ?tag ?id ?value ;
SYMBOL: no-channel SYMBOL: no-channel
TUPLE: to-message id value ;
TUPLE: from-message id ;
: channel-thread ( -- ) : channel-thread ( -- )
[ [
{ {
{ { to ?id ?value } { T{ to-message f ?id ?value }
[ ?value ?id get-channel dup [ to f ] [ 2drop no-channel ] if ] } [ ?value ?id get-channel dup [ to f ] [ 2drop no-channel ] if ] }
{ { from ?id } { T{ from-message f ?id }
[ ?id get-channel [ from ] [ no-channel ] if* ] } [ ?id get-channel [ from ] [ no-channel ] if* ] }
} match-cond } match-cond
] handle-synchronous ; ] handle-synchronous ;
PRIVATE>
: start-channel-node ( -- ) : start-channel-node ( -- )
"remote-channels" get-remote-thread [ "remote-channels" get-remote-thread [
[ channel-thread t ] "Remote channels" spawn-server [ channel-thread t ] "Remote channels" spawn-server
"remote-channels" register-remote-thread "remote-channels" register-remote-thread
] unless ; ] unless ;
PRIVATE>
TUPLE: remote-channel node id ; TUPLE: remote-channel node id ;
C: <remote-channel> remote-channel C: <remote-channel> remote-channel
M: remote-channel to ( value remote-channel -- ) <PRIVATE
[ [ \ to , id>> , , ] { } make ] keep
node>> "remote-channels" <remote-thread>
send-synchronous no-channel = [ no-channel throw ] when ;
M: remote-channel from ( remote-channel -- value ) : send-message ( message remote-channel -- value )
[ [ \ from , id>> , ] { } make ] keep
node>> "remote-channels" <remote-thread> node>> "remote-channels" <remote-thread>
send-synchronous dup no-channel = [ no-channel throw ] when* ; send-synchronous dup no-channel = [ no-channel throw ] when* ;
PRIVATE>
M: remote-channel to ( value remote-channel -- )
[ id>> swap to-message boa ] keep send-message drop ;
M: remote-channel from ( remote-channel -- value )
[ id>> from-message boa ] keep send-message ;
[ [
H{ } clone \ remote-channels set-global H{ } clone \ remote-channels set-global
start-channel-node start-channel-node