Refactor some remote channels code

diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor
index 59dec91859613091a9f759b4bd5e084626610df5..0a8887554491c777078ad001552996d3f62bd66b 100644 (file)
--- 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> 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