From: Chris Double Date: Fri, 30 Oct 2009 01:19:34 +0000 (+1300) Subject: Refactor some remote channels code X-Git-Tag: 0.97~5218^2~2^2~1 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=628a0ba5307639ddf7dbd2fb0ec805996352c293 Refactor some remote channels code --- 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