Nesting, chat example

marketplace/scribblings/concepts.scrbl

@@ -197,3 +197,49 @@ corresponding @racket[absence-event] is sent to the remaining
 endpoint.
 
 @section{Nesting, relaying, and levels of discourse}
+
+Because VMs can be nested, and each VM has an IPC network of its own
+for the use of its processes, information sometimes needs to be
+relayed from a VM's external network to its internal network and vice
+versa.
+
+In general, the protocol messages sent across a VM's internal network
+may be quite different in syntax and meaning from those sent across
+the same VM's external network: consider the case of the
+@secref{chat-server-example}, which employs a nested VM to separate
+out TCP-related messages from higher-level, application-specific chat
+messages:
+
+@vm-figure[(vm (vm-label "Ground VM")
+	       (network-label "TCP")
+	       (process "TCP driver")
+	       (process "TCP listener")
+	       (process-space)
+	       (process "TCP socket mgr.")
+	       (process "TCP socket mgr.")
+	       (process-ellipsis)
+	       (process-space)
+	       (vm (vm-label "Nested VM")
+		   (network-label "(X says Y)")
+		   (process "Listener")
+		   (process-space)
+		   (process "Chat session")
+		   (process "Chat session")
+		   (process-ellipsis)))]
+
+Each VM's network corresponds to a distinct @emph{level of discourse}.
+The nesting of VMs is then roughly analogous to the layering of
+network protocol stacks. For example (and purely hypothetically!) the
+TCP-IP/HTTP/Webapp stack could perhaps be represented as
+
+@vm-figure[(vm (vm-label "Ground VM")
+	       (network-label "TCP/IP")
+	       (process "TCP driver")
+	       (vm (vm-label "HTTP VM")
+		   (network-label "HTTP sessions/reqs/reps")
+		   (process "HTTP accepter")
+		   (vm (vm-label "Session VM")
+		       (network-label "Session-specific msgs")
+		       (process "App process")
+		       (process-ellipsis))
+		   (process-ellipsis)))]

marketplace/scribblings/examples.scrbl

@@ -43,4 +43,43 @@ is the interface between a process and its containing VM. Our
 implementation instantiates this interface as a collection of Typed
 Racket programs.
 
-@section{TCP chat server}
+@section[#:tag "chat-server-example"]{TCP chat server}
+
+@#reader scribble/comment-reader (racketmod #:file "examples/chat-paper.rkt" marketplace
+
+(nested-vm
+ (at-meta-level
+  (endpoint #:subscriber (tcp-channel ? (tcp-listener 5999) ?) #:observer
+	    #:conversation (tcp-channel them us _)
+	    #:on-presence (spawn #:child (chat-session them us)))))
+
+(define (chat-session them us)
+  (define user (gensym 'user))
+  (transition stateless
+	      (listen-to-user user them us)
+	      (speak-to-user user them us)))
+
+(define (listen-to-user user them us)
+  (list
+   (endpoint #:publisher `(,user says ,?))
+   (at-meta-level
+    (endpoint #:subscriber (tcp-channel them us ?)
+	      #:on-absence (quit)
+	      [(tcp-channel _ _ (? bytes? text))
+	       (send-message `(,user says ,text))]))))
+
+(define (speak-to-user user them us)
+  (define (say fmt . args)
+    (at-meta-level (send-message (tcp-channel us them (apply format fmt args)))))
+  (define (announce who did-what)
+    (unless (equal? who user) (say "~s ~s.~n" who did-what)))
+  (list
+   (say "You are ~s.~n" user)
+   (at-meta-level
+    (endpoint #:publisher (tcp-channel us them ?)))
+   (endpoint #:subscriber `(,? says ,?)
+	     #:conversation `(,who says ,_)
+	     #:on-presence (announce who 'arrived)
+	     #:on-absence  (announce who 'departed)
+	     [`(,who says ,what) (say "~a: ~a" who what)])))
+)