Nesting, chat example
This commit is contained in:
parent
6677e21260
commit
3a4e21581b
|
@ -197,3 +197,49 @@ corresponding @racket[absence-event] is sent to the remaining
|
||||||
endpoint.
|
endpoint.
|
||||||
|
|
||||||
@section{Nesting, relaying, and levels of discourse}
|
@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)))]
|
||||||
|
|
|
@ -43,4 +43,43 @@ is the interface between a process and its containing VM. Our
|
||||||
implementation instantiates this interface as a collection of Typed
|
implementation instantiates this interface as a collection of Typed
|
||||||
Racket programs.
|
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)])))
|
||||||
|
)
|
||||||
|
|
Loading…
Reference in New Issue