From 118cdef4c6e5ab9a56c0bafb4ce9d123fbcef6c3 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 14 Mar 2017 18:29:45 -0400 Subject: [PATCH] Refactor other chat servers to match --- .../actor/chat-no-quit-world-no-nesting.rkt | 43 +++++++--------- .../examples/actor/chat-no-quit-world.rkt | 46 ++++++++--------- .../actor/chat-simplified-internals.rkt | 47 ++++++++--------- racket/syndicate/examples/actor/chat.rkt | 51 ++++++++----------- 4 files changed, 80 insertions(+), 107 deletions(-) diff --git a/racket/syndicate/examples/actor/chat-no-quit-world-no-nesting.rkt b/racket/syndicate/examples/actor/chat-no-quit-world-no-nesting.rkt index b0d983a..c3348af 100644 --- a/racket/syndicate/examples/actor/chat-no-quit-world-no-nesting.rkt +++ b/racket/syndicate/examples/actor/chat-no-quit-world-no-nesting.rkt @@ -7,30 +7,23 @@ (struct says (who what) #:prefab) (struct present (who) #:prefab) -(define (spawn-session them us) - (spawn (define (send-to-remote fmt . vs) - (send! (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))) - - (define (say who fmt . vs) - (unless (equal? who user) - (send-to-remote "~a ~a\n" who (apply format fmt vs)))) - - (define user (gensym 'user)) - (on-start (send-to-remote "Welcome, ~a.\n" user)) - - (stop-when (retracted (advertise (tcp-channel them us _)))) - - (assert (present user)) - (on (asserted (present $who)) (say who "arrived.")) - (on (retracted (present $who)) (say who "departed.")) - - (on (message (says $who $what)) (say who "says: ~a" what)) - - (assert (advertise (tcp-channel us them _))) - (on (message (tcp-channel them us $bs)) - (send! (says user (string-trim (bytes->string/utf-8 bs))))))) - (define us (tcp-listener 5999)) (spawn (assert (advertise (observe (tcp-channel _ us _)))) - (on (asserted (advertise (tcp-channel $them us _))) - (spawn-session them us))) + (during/spawn (advertise (tcp-channel $them us _)) + (assert (advertise (tcp-channel us them _))) + + (define (send-to-remote fmt . vs) + (send! (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))) + + (define user (gensym 'user)) + + (on-start (send-to-remote "Welcome, ~a.\n" user)) + (assert (present user)) + (on (message (tcp-channel them us $bs)) + (send! (says user (string-trim (bytes->string/utf-8 bs))))) + + (during (present $who) + (unless (equal? who user) + (on-start (send-to-remote "~a arrived.\n" who)) + (on-stop (send-to-remote "~a departed.\n" who)) + (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))) diff --git a/racket/syndicate/examples/actor/chat-no-quit-world.rkt b/racket/syndicate/examples/actor/chat-no-quit-world.rkt index 43a9f59..ec2387b 100644 --- a/racket/syndicate/examples/actor/chat-no-quit-world.rkt +++ b/racket/syndicate/examples/actor/chat-no-quit-world.rkt @@ -7,30 +7,24 @@ (struct says (who what) #:prefab) (struct present (who) #:prefab) -(define (spawn-session them us) - (spawn (define (send-to-remote fmt . vs) - (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))) - - (define (say who fmt . vs) - (unless (equal? who user) - (send-to-remote "~a ~a\n" who (apply format fmt vs)))) - - (define user (gensym 'user)) - (on-start (send-to-remote "Welcome, ~a.\n" user)) - - (stop-when (retracted (inbound (advertise (tcp-channel them us _))))) - - (assert (present user)) - (on (asserted (present $who)) (say who "arrived.")) - (on (retracted (present $who)) (say who "departed.")) - - (on (message (says $who $what)) (say who "says: ~a" what)) - - (assert (outbound (advertise (tcp-channel us them _)))) - (on (message (inbound (tcp-channel them us $bs))) - (send! (says user (string-trim (bytes->string/utf-8 bs))))))) - (dataspace (define us (tcp-listener 5999)) - (forever (assert (outbound (advertise (observe (tcp-channel _ us _))))) - (on (asserted (inbound (advertise (tcp-channel $them us _)))) - (spawn-session them us)))) + (forever + (assert (outbound (advertise (observe (tcp-channel _ us _))))) + (during/spawn (inbound (advertise (tcp-channel $them us _))) + (assert (outbound (advertise (tcp-channel us them _)))) + + (define (send-to-remote fmt . vs) + (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))) + + (define user (gensym 'user)) + + (on-start (send-to-remote "Welcome, ~a.\n" user)) + (assert (present user)) + (on (message (inbound (tcp-channel them us $bs))) + (send! (says user (string-trim (bytes->string/utf-8 bs))))) + + (during (present $who) + (unless (equal? who user) + (on-start (send-to-remote "~a arrived.\n" who)) + (on-stop (send-to-remote "~a departed.\n" who)) + (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what))))))) diff --git a/racket/syndicate/examples/actor/chat-simplified-internals.rkt b/racket/syndicate/examples/actor/chat-simplified-internals.rkt index 42c6a35..3e8f6c5 100644 --- a/racket/syndicate/examples/actor/chat-simplified-internals.rkt +++ b/racket/syndicate/examples/actor/chat-simplified-internals.rkt @@ -9,31 +9,6 @@ (struct tcp-incoming-data (id bytes) #:prefab) (struct tcp-outgoing-data (id bytes) #:prefab) -(struct says (who what) #:prefab) -(struct present (who) #:prefab) - -(define (spawn-session id) - (spawn (define (send-to-remote fmt . vs) - (send! (tcp-outgoing-data id (string->bytes/utf-8 (apply format fmt vs))))) - - (define (say who fmt . vs) - (unless (equal? who user) - (send-to-remote "~a ~a\n" who (apply format fmt vs)))) - - (define user (gensym 'user)) - (on-start (send-to-remote "Welcome, ~a.\n" user)) - - (stop-when (retracted (tcp-remote-open id))) - (assert (tcp-local-open id)) - (assert (present user)) - - (on (asserted (present $who)) (say who "arrived.")) - (on (retracted (present $who)) (say who "departed.")) - (on (message (says $who $what)) (say who "says: ~a" what)) - - (on (message (tcp-incoming-data id $bs)) - (send! (says user (string-trim (bytes->string/utf-8 bs))))))) - (define us (tcp-listener 5999)) (spawn (assert (advertise (observe (tcp-channel _ us _)))) (on (asserted (advertise (tcp-channel $them us _))) @@ -46,5 +21,23 @@ (on (message (tcp-outgoing-data id $bs)) (send! (tcp-channel us them bs)))))) -(spawn (on (asserted (tcp-remote-open $id)) - (spawn-session id))) +(struct says (who what) #:prefab) +(struct present (who) #:prefab) + +(spawn (during/spawn (tcp-remote-open $id) + (assert (tcp-local-open id)) + + (define (send-to-remote fmt . vs) + (send! (tcp-outgoing-data id (string->bytes/utf-8 (apply format fmt vs))))) + + (define user (gensym 'user)) + (on-start (send-to-remote "Welcome, ~a.\n" user)) + (assert (present user)) + (on (message (tcp-incoming-data id $bs)) + (send! (says user (string-trim (bytes->string/utf-8 bs))))) + + (during (present $who) + (unless (equal? who user) + (on-start (send-to-remote "~a arrived.\n" who)) + (on-stop (send-to-remote "~a departed.\n" who)) + (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))) diff --git a/racket/syndicate/examples/actor/chat.rkt b/racket/syndicate/examples/actor/chat.rkt index 4a1ea06..15716ad 100644 --- a/racket/syndicate/examples/actor/chat.rkt +++ b/racket/syndicate/examples/actor/chat.rkt @@ -8,34 +8,27 @@ (struct present (who) #:prefab) (struct shutdown () #:prefab) -(define (spawn-session them us) - (spawn (define (send-to-remote fmt . vs) - (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))) - - (define (say who fmt . vs) - (unless (equal? who user) - (send-to-remote "~a ~a\n" who (apply format fmt vs)))) - - (define user (gensym 'user)) - (on-start (send-to-remote "Welcome, ~a.\n" user)) - - (stop-when (retracted (inbound (advertise (tcp-channel them us _))))) - - (assert (present user)) - (on (asserted (present $who)) (say who "arrived.")) - (on (retracted (present $who)) (say who "departed.")) - - (on (message (says $who $what)) (say who "says: ~a" what)) - - (assert (outbound (advertise (tcp-channel us them _)))) - (on (message (inbound (tcp-channel them us $bs))) - (define input-string (string-trim (bytes->string/utf-8 bs))) - (if (equal? input-string "quit-dataspace") - (send! (shutdown)) - (send! (says user input-string)))))) - (dataspace (define us (tcp-listener 5999)) (until (message (shutdown)) - (assert (outbound (advertise (observe (tcp-channel _ us _))))) - (on (asserted (inbound (advertise (tcp-channel $them us _)))) - (spawn-session them us)))) + (assert (outbound (advertise (observe (tcp-channel _ us _))))) + (during/spawn (inbound (advertise (tcp-channel $them us _))) + (assert (outbound (advertise (tcp-channel us them _)))) + + (define (send-to-remote fmt . vs) + (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))) + + (define user (gensym 'user)) + + (on-start (send-to-remote "Welcome, ~a.\n" user)) + (assert (present user)) + (on (message (inbound (tcp-channel them us $bs))) + (define input-string (string-trim (bytes->string/utf-8 bs))) + (if (equal? input-string "quit-dataspace") + (send! (shutdown)) + (send! (says user input-string)))) + + (during (present $who) + (unless (equal? who user) + (on-start (send-to-remote "~a arrived.\n" who)) + (on-stop (send-to-remote "~a departed.\n" who)) + (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))