! 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
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> remote-channel
-M: remote-channel to ( value remote-channel -- )
- [ [ \ to , id>> , , ] { } make ] keep
- node>> "remote-channels" <remote-thread>
- send-synchronous no-channel = [ no-channel throw ] when ;
+<PRIVATE
-M: remote-channel from ( remote-channel -- value )
- [ [ \ from , id>> , ] { } make ] keep
+: send-message ( message remote-channel -- value )
node>> "remote-channels" <remote-thread>
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