syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

New examples

This commit is contained in:
Tony Garnock-Jones 2017-12-05 17:32:12 +00:00
parent eb564fdb7c
commit eb44003317
2 changed files with 59 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
racket/syndicate/examples/actor/simple-dns.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang syndicate
;; Sketch of a DNS intra-program protocol
(assertion-struct dns-entry (name address))
(require/activate syndicate/drivers/timestate)
(spawn #:name 'server
(during (observe (dns-entry "localhost" _))
(on-start (printf "asserting localhost record\n"))
(on-stop (printf "retracting localhost record\n"))
(assert (dns-entry "localhost" "127.0.0.1"))))
(spawn #:name 'cache
(on (asserted (dns-entry $name $addr))
(define deadline (+ (current-inexact-milliseconds) 5000))
(react (stop-when (asserted (later-than deadline)))
(on-start (printf "caching ~a = ~a\n" name addr))
(on-stop (printf "uncaching ~a = ~a\n" name addr))
(assert (dns-entry name addr)))))
(spawn #:name 'main
(stop-when (asserted (dns-entry "localhost" $addr))
(printf "localhost is ~a\n" addr)
(sleep 1)
(react (stop-when (asserted (dns-entry "localhost" $addr))
(printf "localhost is still ~a\n" addr)))))

32
racket/syndicate/examples/actor/tcp-relay.rkt Normal file
View File

@ -0,0 +1,32 @@
#lang syndicate
;; Simple TCP relay
(require/activate syndicate/drivers/tcp2)
(define (read-tcp-line id)
(react/suspend (k)
(on (message (tcp-in-line id $line-bytes))
(k (bytes->string/utf-8 line-bytes)))))
(spawn #:name 'server
(during (tcp-connection $id (tcp-listener 5000))
(assert (tcp-accepted id))
(on-start (printf "Accepted ~a\n" id))
(on-stop (printf "Disconnected ~a\n" id))
(define connection-facet-id (current-facet-id))
(on-start (send! (tcp-out id #"Please enter the host to connect to: "))
(define host (read-tcp-line id))
(send! (tcp-out id #"Please enter the port to connect to: "))
(define port (string->number (read-tcp-line id)))
(define outbound-id (gensym 'outbound-id))
(react (assert (tcp-connection outbound-id (tcp-address host port)))
(during (tcp-accepted outbound-id)
(on-start (printf "Connected ~a => ~a\n" id outbound-id))
(on-stop (printf "Disconnected ~a => ~a\n" id outbound-id))
(on-stop (stop-facet connection-facet-id))
(on (message (tcp-in id $bs))
(printf "Relaying ~a -> ~a: ~v\n" id outbound-id bs)
(send! (tcp-out outbound-id bs)))
(on (message (tcp-in outbound-id $bs))
(printf "Relaying ~a <- ~a: ~v\n" id outbound-id bs)
(send! (tcp-out id bs))))))))