syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

More cosmetic tweaks

This commit is contained in:
Tony Garnock-Jones 2012-08-08 16:48:24 -04:00
parent e7a630c6e9
commit fc463db770
1 changed files with 19 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
chat-os2-paper.rkt
View File

@ -20,17 +20,31 @@
#:on-presence
(spawn (connection-handler t))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (connection-handler t)
(define me (gensym 'user))
(define-values
(cin cout in-topic out-topic)
(define-values (cin cout in-t out-t)
(tcp-accept t))
(transition 'no-state
(net-roles me cin cout
in-topic out-topic)
(net-roles me cin cout in-t out-t)
(chat-roles me cout)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (net-roles me cin cout in-t out-t)
(at-meta-level
(cout (term->bytes `(you-are ,me)))
(cin (tcp-mode 'lines))
(cin (tcp-credit 1))
(role out-t)
(role in-t
#:on-absence (kill)
[(tcp-channel _ _ (? bytes? line))
(list (at-meta-level
(cin (tcp-credit 1)))
(send-message
`(,me says ,line)))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (chat-roles me cout)
(define (announce t did-what)
(define who (first (topic-pattern t)))
@ -49,22 +63,6 @@
[msg (at-meta-level
(cout (term->bytes msg)))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (net-roles me cin cout
in-topic out-topic)
(at-meta-level
(cout (term->bytes `(you-are ,me)))
(cin (tcp-mode 'lines))
(cin (tcp-credit 1))
(role out-topic)
(role in-topic
#:on-absence (kill)
[(tcp-channel _ _ (? bytes? line))
(list (at-meta-level
(cin (tcp-credit 1)))
(send-message
`(,me says ,line)))])))
(ground-vm
(spawn tcp-driver)
(spawn listener))