Merge branch 'master' of vapour:racket-matrix

chat-os2-paper.rkt

@@ -10,6 +10,8 @@
   (with-output-to-bytes
     (lambda () (write v) (newline))))
 
+(define tcp tcp-driver)
+
 ;;---------------------------------------------------------------------------
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -25,7 +27,7 @@
 (define (connection-handler t)
   (define me (gensym 'user))
   (define-values (cin cout in-t out-t)
-    (tcp-accept t))
+    (topic->tcp-connection t))
   (transition 'no-state
     (net-roles me cin cout in-t out-t)
     (chat-roles me cout)))
@@ -62,6 +64,5 @@
     [msg (at-meta-level
 	  (cout (term->bytes msg)))])))
 
-(ground-vm (spawn tcp-driver)
-	   (spawn listener))
+(ground-vm (spawn tcp) (spawn listener))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

chat-os2.rkt

@@ -16,7 +16,7 @@
 
 (define (connection-handler t)
   (match-define (topic _ (tcp-channel connection-id _ _) _) t)
-  (define-values (cin cout in-topic out-topic) (tcp-accept t))
+  (define-values (cin cout in-topic out-topic) (topic->tcp-connection t))
   (transition 'no-state
     (role (topic-publisher `(,connection-id says ,?)))
     (role (topic-subscriber `(,? says ,?))

chat.erl

@@ -0,0 +1,57 @@
+-module(chat).
+
+-export([start/0]).
+
+start() ->
+    IndexPid = spawn(fun () -> index([]) end),
+    {ok, LSock} = gen_tcp:listen(5999, [{active, true}, {packet, line}, {reuseaddr, true}]),
+    accept_loop(LSock, IndexPid).
+
+accept_loop(LSock, IndexPid) ->
+    case gen_tcp:accept(LSock) of
+        {ok, Sock} ->
+            gen_tcp:controlling_process(Sock, spawn(fun () -> connection(Sock, IndexPid) end)),
+            accept_loop(LSock, IndexPid)
+    end.
+
+index(Connected) ->
+    receive
+        {arrive, Pid} ->
+            [begin
+                 P ! {utterance, {arrive, Pid}},
+                 Pid ! {utterance, {arrive, P}}
+             end || P <- Connected],
+            monitor(process, Pid),
+            index([Pid | Connected]);
+        {'DOWN', _, process, Pid, _} ->
+            NewConnected = Connected -- [Pid],
+            [P ! {utterance, {depart, Pid}} || P <- NewConnected],
+            index(NewConnected);
+        M = {_Pid, says, _Thing} ->
+            [P ! {utterance, M} || P <- Connected],
+            index(Connected);
+        Other ->
+            error_logger:error_report({index, unhandled, Other})
+    end.
+
+say(Sock, V) ->
+    gen_tcp:send(Sock, io_lib:format("~p~n", [V])).
+
+connection(Sock, IndexPid) ->
+    IndexPid ! {arrive, self()},
+    say(Sock, {you_are, self()}),
+    connection_mainloop(Sock, IndexPid).
+
+connection_mainloop(Sock, IndexPid) ->
+    receive
+        {utterance, V} ->
+            say(Sock, V),
+            connection_mainloop(Sock, IndexPid);
+        {tcp, _, Line} ->
+            IndexPid ! {self(), says, Line},
+            connection_mainloop(Sock, IndexPid);
+        {tcp_closed, _} ->
+            ok;
+        Other ->
+            error_logger:error_report({connection, unhandled, Other})
+    end.

fake-tcp.rkt

@@ -9,7 +9,7 @@
 	 (rename-out [base:tcp-spy tcp-spy])
 
 	 tcp-listener
-	 tcp-accept
+	 topic->tcp-connection
 
 	 (rename-out [base:tcp-channel tcp-channel])
 	 (rename-out [base:tcp-credit tcp-credit])
@@ -27,7 +27,7 @@
 ;; functions that create communication requests relating to that
 ;; connection, and also creates topics useful for hearing
 ;; communications relating to that connection.
-(define (tcp-accept new-topic)
+(define (topic->tcp-connection new-topic)
   (match-define (topic _ (base:tcp-channel remote-addr local-addr _) _) new-topic)
   (define (cin feedback) (send-feedback (base:tcp-channel remote-addr local-addr feedback)))
   (define (cout data) (send-message (base:tcp-channel local-addr remote-addr data)))