1 ! Copyright (C) 2007 Chris Double. All Rights Reserved.
2 ! See http://factorcode.org/license.txt for BSD license.
5 USING: kernel init namespaces assocs arrays random
6 sequences channels match concurrency.messaging
7 concurrency.distributed threads accessors ;
12 : remote-channels ( -- hash )
13 \ remote-channels get-global ;
16 : publish ( channel -- id )
17 256 random-bits dup [ remote-channels set-at ] dip ;
19 : get-channel ( id -- channel )
23 remote-channels delete-at ;
27 MATCH-VARS: ?from ?tag ?id ?value ;
30 TUPLE: to-message id value ;
31 TUPLE: from-message id ;
33 : channel-thread ( -- )
36 { T{ to-message f ?id ?value }
37 [ ?value ?id get-channel dup [ to f ] [ 2drop no-channel ] if ] }
38 { T{ from-message f ?id }
39 [ ?id get-channel [ from ] [ no-channel ] if* ] }
41 ] handle-synchronous ;
43 : start-channel-node ( -- )
44 "remote-channels" get-remote-thread [
45 [ channel-thread t ] "Remote channels" spawn-server
46 "remote-channels" register-remote-thread
51 TUPLE: remote-channel node id ;
53 C: <remote-channel> remote-channel
57 : send-message ( message remote-channel -- value )
58 node>> "remote-channels" <remote-thread>
59 send-synchronous dup no-channel = [ no-channel throw ] when* ;
63 M: remote-channel to ( value remote-channel -- )
64 [ id>> swap to-message boa ] keep send-message drop ;
66 M: remote-channel from ( remote-channel -- value )
67 [ id>> from-message boa ] keep send-message ;
70 H{ } clone \ remote-channels set-global
72 ] "channel-registry" add-init-hook