diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor index 59dec91859..0a88875544 100644 --- a/basis/channels/remote/remote.factor +++ b/basis/channels/remote/remote.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. ! ! Remote Channels -USING: kernel init namespaces make assocs arrays random +USING: kernel init namespaces assocs arrays random sequences channels match concurrency.messaging concurrency.distributed threads accessors ; IN: channels.remote @@ -27,38 +27,44 @@ PRIVATE> MATCH-VARS: ?from ?tag ?id ?value ; SYMBOL: no-channel +TUPLE: to-message id value ; +TUPLE: from-message id ; : channel-thread ( -- ) [ { - { { to ?id ?value } + { T{ to-message f ?id ?value } [ ?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* ] } } match-cond ] handle-synchronous ; -PRIVATE> - : start-channel-node ( -- ) "remote-channels" get-remote-thread [ [ channel-thread t ] "Remote channels" spawn-server "remote-channels" register-remote-thread ] unless ; +PRIVATE> + TUPLE: remote-channel node id ; C: remote-channel -M: remote-channel to ( value remote-channel -- ) - [ [ \ to , id>> , , ] { } make ] keep - node>> "remote-channels" - send-synchronous no-channel = [ no-channel throw ] when ; +> , ] { } make ] keep +: send-message ( message remote-channel -- value ) node>> "remote-channels" 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