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

Introduce syndicate module *activation*. 

Make #lang syndicate module-begin gather boot actions into a
syndicate-main submodule, and for each such module, add a main
submodule that calls run-ground with the syndicate-main boot actions.

This lets us write syndicate *libraries* that comprise both
data-structures, functions, and Syndicate services.
This commit is contained in:
Tony Garnock-Jones 2016-07-12 15:05:56 -04:00
parent e8d33d4135
commit 0b06bcf1c4
37 changed files with 95 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
racket/syndicate/broker/server.rkt
View File

@ -1,4 +1,4 @@
#lang racket/base
#lang syndicate/actor
;; Generic relay for WebSockets/TCP/etc-based participation in a network.
(provide spawn-broker-server
@ -110,18 +110,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module+ main
(require syndicate/ground)
(require syndicate/actor)
(require syndicate/drivers/timer)
(require syndicate/drivers/websocket)
(define ssl-options
(match (current-command-line-arguments)
[(vector c p) (websocket-ssl-options c p)]
[_ #f]))
(run-ground (spawn-timer-driver)
(spawn-websocket-driver)
(dataspace (schedule-action! (spawn-broker-server 8000))
(when ssl-options
(schedule-action! (spawn-broker-server 8443 #:ssl-options ssl-options)))
(forever))))
(require/activate syndicate/drivers/timer)
(require/activate syndicate/drivers/websocket)
(let ((ssl-options
(match (current-command-line-arguments)
[(vector c p) (websocket-ssl-options c p)]
[_ #f])))
(dataspace (schedule-action! (spawn-broker-server 8000))
(when ssl-options
(schedule-action! (spawn-broker-server 8443 #:ssl-options ssl-options)))
(forever)))

8
racket/syndicate/drivers/tcp.rkt
View File

@ -1,10 +1,8 @@
#lang racket/base
#lang syndicate
(require racket/match)
(require racket/exn)
(require (prefix-in tcp: racket/tcp))
(require (only-in racket/port read-bytes-avail!-evt))
(require "../main.rkt")
(require "../demand-matcher.rkt")
(require racket/unit)
@ -187,3 +185,7 @@
(sub (tcp-channel local-addr remote-addr ?)) ;; want segments from peer
(sub (tcp-channel remote-addr local-addr ?) #:meta-level 1) ;; segments from driver thread
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(spawn-tcp-driver)

8
racket/syndicate/drivers/timer.rkt
View File

@ -1,4 +1,4 @@
#lang racket/base
#lang syndicate
;; Timer driver.
;; Uses mutable state internally, but because the scope of the
@ -6,9 +6,7 @@
;; correct linear use of the various pointers.
(require racket/set)
(require racket/match)
(require data/heap)
(require "../main.rkt")
(struct pending-timer (deadline label) #:transparent)
@ -126,3 +124,7 @@
(define (timer-evt msecs)
(handle-evt (alarm-evt msecs)
(lambda (_) (current-inexact-milliseconds))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(spawn-timer-driver)

8
racket/syndicate/drivers/udp.rkt
View File

@ -1,8 +1,6 @@
#lang racket/base
#lang syndicate
(require racket/match)
(require (prefix-in udp: racket/udp))
(require "../main.rkt")
(require "../demand-matcher.rkt")
(provide (struct-out udp-remote-address)
@ -112,3 +110,7 @@
(subbytes buffer 0 len)))
(loop)))))
(udp:udp-close socket))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(spawn-udp-driver)

8
racket/syndicate/drivers/websocket.rkt
View File

@ -1,4 +1,4 @@
#lang racket/base
#lang syndicate
(provide (struct-out websocket-remote-client)
(struct-out websocket-local-server)
@ -11,14 +11,12 @@
any-websocket-remote-client)
(require racket/exn)
(require racket/match)
(require net/rfc6455)
(require (only-in net/rfc6455/conn-api
ws-conn-base-ip
ws-conn-peer-addresses
ws-conn-host+port
ws-conn-path))
(require "../main.rkt")
(require "../demand-matcher.rkt")
(require racket/unit)
@ -221,3 +219,7 @@
(sub (websocket-message local-addr remote-addr ?)) ;; want segments from peer
(sub (websocket-incoming-message id ?) #:meta-level 1) ;; segments from driver thd
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(spawn-websocket-driver)

4
racket/syndicate/examples/actor/chain.rkt
View File

@ -1,8 +1,6 @@
#lang syndicate/actor
(require syndicate/drivers/timer)
(spawn-timer-driver)
(require/activate syndicate/drivers/timer)
(define (sleep sec)
(define timer-id (gensym 'sleep))

4
racket/syndicate/examples/actor/chat-client.rkt
View File

@ -1,14 +1,12 @@
#lang syndicate/actor
(require syndicate/drivers/tcp)
(require/activate syndicate/drivers/tcp)
(require (only-in racket/port read-bytes-line-evt))
(define local-handle (tcp-handle 'chat))
(define remote-handle (tcp-address "localhost" 5999))
(define stdin-evt (read-bytes-line-evt (current-input-port) 'any))
(spawn-tcp-driver)
(actor
(react/suspend (quit)
(on (message (external-event stdin-evt (list $line)) #:meta-level 1)

3
racket/syndicate/examples/actor/chat-no-quit-world-no-nesting.rkt
View File

@ -1,6 +1,6 @@
#lang syndicate/actor
(require syndicate/drivers/tcp)
(require/activate syndicate/drivers/tcp)
(require (only-in racket/string string-trim))
(struct says (who what) #:prefab)
@ -28,7 +28,6 @@
(on (message (tcp-channel them us $bs))
(send! (says user (string-trim (bytes->string/utf-8 bs))))))))
(spawn-tcp-driver)
(define us (tcp-listener 5999))
(actor
(forever (assert (advertise (observe (tcp-channel _ us _))))

3
racket/syndicate/examples/actor/chat-no-quit-world.rkt
View File

@ -1,6 +1,6 @@
#lang syndicate/actor
(require syndicate/drivers/tcp)
(require/activate syndicate/drivers/tcp)
(require (only-in racket/string string-trim))
(struct says (who what) #:prefab)
@ -29,7 +29,6 @@
(on (message (tcp-channel them us $bs) #:meta-level 1)
(send! (says user (string-trim (bytes->string/utf-8 bs))))))))
(spawn-tcp-driver)
(dataspace (define us (tcp-listener 5999))
(forever (assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1)
(on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1)

4
racket/syndicate/examples/actor/chat-simplified-internals.rkt
View File

@ -1,6 +1,6 @@
#lang syndicate/actor
(require syndicate/drivers/tcp)
(require/activate syndicate/drivers/tcp)
(require (only-in racket/string string-trim))
(struct tcp-remote-open (id) #:prefab)
@ -33,8 +33,6 @@
(on (message (tcp-incoming-data id $bs))
(send! (says user (string-trim (bytes->string/utf-8 bs))))))))
(spawn-tcp-driver)
(define us (tcp-listener 5999))
(actor (forever (assert (advertise (observe (tcp-channel _ us _))))
(on (asserted (advertise (tcp-channel $them us _)))

3
racket/syndicate/examples/actor/chat.rkt
View File

@ -1,6 +1,6 @@
#lang syndicate/actor
(require syndicate/drivers/tcp)
(require/activate syndicate/drivers/tcp)
(require (only-in racket/string string-trim))
(struct says (who what) #:prefab)
@ -33,7 +33,6 @@
(send! (shutdown))
(send! (says user input-string)))))))
(spawn-tcp-driver)
(dataspace (define us (tcp-listener 5999))
(until (message (shutdown))
(assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1)

4
racket/syndicate/examples/actor/echo.rkt
View File

@ -1,8 +1,6 @@
#lang syndicate/actor
(require syndicate/drivers/tcp)
(spawn-tcp-driver)
(require/activate syndicate/drivers/tcp)
(define server-id (tcp-listener 5999))
(actor

4
racket/syndicate/examples/actor/file-system-during.rkt
View File

@ -2,7 +2,7 @@
;; Toy file system, based on the example in the ESOP2016 submission.
;; syndicate/actor implementation, using "during" instead of "on asserted/until retracted".
(require syndicate/drivers/timer)
(require/activate syndicate/drivers/timer)
(require (only-in racket/port read-bytes-line-evt))
(require (only-in racket/string string-trim string-split))
@ -10,8 +10,6 @@
(struct save (file) #:prefab)
(struct delete (name) #:prefab)
(spawn-timer-driver)
(actor (react (field [files (hash)])
(during (observe (file $name _))
(on-start (printf "At least one reader exists for ~v\n" name))

4
racket/syndicate/examples/actor/file-system-lll.rkt
View File

@ -3,7 +3,7 @@
;; Low-level implementation.
(require (only-in syndicate [assert core:assert]))
(require syndicate/drivers/timer)
(require/activate syndicate/drivers/timer)
(require (only-in racket/port read-bytes-line-evt))
(require (only-in racket/string string-trim string-split))
(require racket/set)
@ -12,8 +12,6 @@
(struct save (file) #:prefab)
(struct delete (name) #:prefab)
(spawn-timer-driver)
(define (file-system-event-handler e files)
(match-event e
[(? patch? p)

4
racket/syndicate/examples/actor/file-system-lll2.rkt
View File

@ -3,7 +3,7 @@
;; Low-level implementation, without subconversation.
(require (only-in syndicate [assert core:assert]))
(require syndicate/drivers/timer)
(require/activate syndicate/drivers/timer)
(require (only-in racket/port read-bytes-line-evt))
(require (only-in racket/string string-trim string-split))
(require racket/set)
@ -14,8 +14,6 @@
(struct fs-state (files monitored) #:prefab)
(spawn-timer-driver)
(define (update-file state name new-content)
(transition (struct-copy fs-state state
[files (if new-content

4
racket/syndicate/examples/actor/file-system.rkt
View File

@ -2,7 +2,7 @@
;; Toy file system, based on the example in the ESOP2016 submission.
;; syndicate/actor implementation.
(require syndicate/drivers/timer)
(require/activate syndicate/drivers/timer)
(require (only-in racket/port read-bytes-line-evt))
(require (only-in racket/string string-trim string-split))
@ -10,8 +10,6 @@
(struct save (file) #:prefab)
(struct delete (name) #:prefab)
(spawn-timer-driver)
(actor (react (field [files (hash)])
(on (asserted (observe (file $name _)))
(printf "At least one reader exists for ~v\n" name)

4
racket/syndicate/examples/actor/file-system2.rkt
View File

@ -2,7 +2,7 @@
;; Toy file system, based on the example in the ESOP2016 submission.
;; syndicate/actor implementation, without subconversation.
(require syndicate/drivers/timer)
(require/activate syndicate/drivers/timer)
(require (only-in racket/port read-bytes-line-evt))
(require (only-in racket/string string-trim string-split))
(require racket/set)
@ -11,8 +11,6 @@
(struct save (file) #:prefab)
(struct delete (name) #:prefab)
(spawn-timer-driver)
(actor (react (field [files (hash)] [monitored (set)])
(on (asserted (observe (file $name _)))
(printf "At least one reader exists for ~v\n" name)

1
racket/syndicate/examples/actor/spreadsheet.rkt
View File

@ -1,7 +1,6 @@
#lang syndicate/actor
;; A toy spreadsheet model.
(require racket/match)
(require racket/set)
(define-namespace-anchor ns)

3
racket/syndicate/examples/all-pairs-shortest-paths/all-pairs-shortest-paths.rkt
View File

@ -1,4 +1,4 @@
#lang syndicate
#lang syndicate/actor
;; After Figure 1 in "Logic and lattices for distributed programming",
;; Conway et. al, UCB tech report, 2012
;;
@ -6,7 +6,6 @@
;; input.
(require racket/set)
(require syndicate/actor)
(struct link (from to cost) #:prefab)
(struct path (from to cost) #:prefab)

3
racket/syndicate/examples/all-pairs-shortest-paths/all-pairs-shortest-paths2.rkt
View File

@ -1,11 +1,10 @@
#lang syndicate
#lang syndicate/actor
;; After Figure 1 in "Logic and lattices for distributed programming",
;; Conway et. al, UCB tech report, 2012
;;
;; Added path-seen set to ensure termination on input cycles.
(require racket/set)
(require syndicate/actor)
(struct link (from to cost) #:prefab)
(struct path (from to seen cost) #:prefab)

3
racket/syndicate/examples/chat-client.rkt
View File

@ -1,12 +1,11 @@
#lang syndicate
(require (only-in racket/port read-bytes-line-evt))
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(define local-handle (tcp-handle 'chat))
(define remote-handle (tcp-address "localhost" 5999))
(spawn-tcp-driver)
(spawn/stateless (lambda (e)
(match e
[(? patch/removed?) (quit)]

3
racket/syndicate/examples/chat-no-quit-world-no-nesting.rkt
View File

@ -1,7 +1,7 @@
#lang syndicate
(require (only-in racket/string string-trim))
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(require "../demand-matcher.rkt")
(define (spawn-session them us)
@ -36,7 +36,6 @@
(pub (tcp-channel us them ?)) ;; we will write to remote client
))))
(spawn-tcp-driver)
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
spawn-session)

3
racket/syndicate/examples/chat-no-quit-world.rkt
View File

@ -1,7 +1,7 @@
#lang syndicate
(require (only-in racket/string string-trim))
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(require "../demand-matcher.rkt")
(define (spawn-session them us)
@ -36,7 +36,6 @@
(pub (tcp-channel us them ?) #:meta-level 1) ;; we will write to remote client
))))
(spawn-tcp-driver)
(spawn-dataspace
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))

4
racket/syndicate/examples/chat-simplified-internals.rkt
View File

@ -3,7 +3,7 @@
;; driver's protocol.
(require (only-in racket/string string-trim))
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(require "../demand-matcher.rkt")
(struct tcp-remote-open (id) #:prefab)
@ -63,8 +63,6 @@
(assert (tcp-local-open id)) ;; indicate our end of the connection is up
))))
(spawn-tcp-driver)
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
tcp-proxy-process)

3
racket/syndicate/examples/chat.rkt
View File

@ -1,7 +1,7 @@
#lang syndicate
(require (only-in racket/string string-trim))
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(require "../demand-matcher.rkt")
(define (spawn-session them us)
@ -39,7 +39,6 @@
(pub (tcp-channel us them ?) #:meta-level 1) ;; we will write to remote client
))))
(spawn-tcp-driver)
(spawn-dataspace
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))

3
racket/syndicate/examples/echo.rkt
View File

@ -1,11 +1,10 @@
#lang syndicate
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(require "../demand-matcher.rkt")
(define server-id (tcp-listener 5999))
(spawn-tcp-driver)
(spawn-demand-matcher (advertise (tcp-channel (?!) server-id ?))
(observe (tcp-channel (?!) server-id ?))
(lambda (c)

4
racket/syndicate/examples/endpoint-example.rkt
View File

@ -1,9 +1,7 @@
#lang syndicate
(require "../endpoint.rkt")
(require "../drivers/timer.rkt")
(spawn-timer-driver)
(require/activate "../drivers/timer.rkt")
(define ((log-it eid) e u)
(log-info "endpoint ~a state ~a: ~v" eid u e)

3
racket/syndicate/examples/example-lang.rkt
View File

@ -1,7 +1,7 @@
#lang syndicate
(require (only-in racket/port read-line-evt))
(require "../drivers/timer.rkt")
(require/activate "../drivers/timer.rkt")
(define (quasi-spy e s)
(printf "----------------------------------------\n")
@ -55,7 +55,6 @@
(quit))]
[_ #f]))
(spawn-timer-driver)
(message (set-timer 'tick 1000 'relative))
(spawn ticker
1

4
racket/syndicate/examples/forward-chaining.rkt
View File

@ -3,9 +3,7 @@
(require racket/set)
(require "../trie.rkt")
(require "../demand-matcher.rkt")
(require "../drivers/timer.rkt")
(spawn-timer-driver)
(require/activate "../drivers/timer.rkt")
(spawn (lambda (e old-count)
(match e

4
racket/syndicate/examples/tcp-hello.rkt
View File

@ -1,10 +1,8 @@
#lang syndicate
(require "../drivers/tcp.rkt")
(require/activate "../drivers/tcp.rkt")
(require "../demand-matcher.rkt")
(spawn-tcp-driver)
(define server-id (tcp-listener 5999))
(define (spawn-connection-handler c)

4
racket/syndicate/examples/udp-hello-plain.rkt
View File

@ -1,8 +1,6 @@
#lang syndicate
(require "../drivers/udp.rkt")
(spawn-udp-driver)
(require/activate "../drivers/udp.rkt")
(spawn (lambda (e s)
(match e

10
racket/syndicate/examples/udp-multicast.rkt
View File

@ -1,13 +1,9 @@
#lang syndicate
#lang syndicate/actor
(require syndicate/actor)
(require syndicate/drivers/timer)
(require syndicate/drivers/udp)
(require/activate syndicate/drivers/timer)
(require/activate syndicate/drivers/udp)
(require racket/random file/sha1)
(spawn-timer-driver)
(spawn-udp-driver)
;; IANA offers guidelines for choosing multicast addresses [1].
;;
;; Reasonable candidates for local experimentation include:

7
racket/syndicate/examples/ws-echo-client.rkt
View File

@ -1,10 +1,9 @@
#lang syndicate
#lang syndicate/actor
;; Websocket echo client
;; racket ws-echo-client.rkt ws://localhost:8081/
;; racket ws-echo-client.rkt wss://localhost:8084/
(require syndicate/drivers/websocket)
(require syndicate/actor)
(require/activate syndicate/drivers/websocket)
(require racket/port)
(define url
@ -12,8 +11,6 @@
[(vector url) url]
[(vector) "http://localhost:8081/ws-echo"]))
(spawn-websocket-driver)
(define c (websocket-local-client (gensym 'c)))
(define s (websocket-remote-server url))

7
racket/syndicate/examples/ws-echo.rkt
View File

@ -1,10 +1,7 @@
#lang syndicate
#lang syndicate/actor
;; Websocket server that echoes all it receives
(require syndicate/drivers/websocket)
(require syndicate/actor)
(spawn-websocket-driver)
(require/activate syndicate/drivers/websocket)
(define any-client any-websocket-remote-client)
(define tcp-server-id (websocket-local-server 8081 #f))

4
racket/syndicate/examples/ws-hello-ssl.rkt
View File

@ -1,10 +1,8 @@
#lang syndicate
(require "../drivers/websocket.rkt")
(require/activate "../drivers/websocket.rkt")
(require "../demand-matcher.rkt")
(spawn-websocket-driver)
(define any-client any-websocket-remote-client)
(define server-id (websocket-local-server 8081 (websocket-ssl-options "server-cert.pem"
"private-key.pem")))

4
racket/syndicate/examples/ws-hello.rkt
View File

@ -1,10 +1,8 @@
#lang syndicate
(require "../drivers/websocket.rkt")
(require/activate "../drivers/websocket.rkt")
(require "../demand-matcher.rkt")
(spawn-websocket-driver)
(define any-client any-websocket-remote-client)
(define server-id (websocket-local-server 8081 #f))

30
racket/syndicate/lang.rkt
View File

@ -6,11 +6,29 @@
(require "main.rkt")
(provide (rename-out [module-begin #%module-begin])
activate
require/activate
(except-out (all-from-out racket/base) #%module-begin)
(all-from-out racket/match)
(all-from-out "main.rkt")
(for-syntax (all-from-out racket/base)))
(define-syntax (activate stx)
(syntax-case stx ()
[(_ module-path ...)
#'(begin
(let ()
(local-require (submod module-path syndicate-main))
(activate!))
...)]))
(define-syntax (require/activate stx)
(syntax-case stx ()
[(_ module-path ...)
#'(begin
(require module-path ...)
(activate module-path ...))]))
(define-syntax (module-begin stx)
(unless (eq? (syntax-local-context) 'module-begin)
(raise-syntax-error #f "allowed only around a module body" stx))
@ -21,7 +39,17 @@
(if (null? forms)
(let ((final-stx
#`(#%module-begin #,@(reverse final-forms)
(run-ground #,@(reverse action-ids)))))
(module+ syndicate-main
(provide boot-actions activate!)
(define activated? #f)
(define boot-actions (list #,@(reverse action-ids)))
(define (activate!)
(when (not activated?)
(set! activated? #t)
boot-actions)))
(module+ main
(require (submod ".." syndicate-main))
(run-ground (activate!))))))
;;(pretty-print (syntax->datum final-stx))
final-stx)
(syntax-case (local-expand (car forms)