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

Reimplement Syndicate/Racket with a new design. 

This is Syndicate/Racket v2, modeled more closely after Syndicate/js.
Facets and Endpoints are now contained within a single actor, unlike
Syndicate/Racket v1, where a linkage protocol between multiple actors
was used. The approach to actor and facet state has been revised as a
consequence.

Almost all the examples using syndicate/actor have been updated.
This commit is contained in:
Tony Garnock-Jones 2016-07-09 16:18:30 -04:00
parent 52aed3111c
commit 8ca2b1ac0c
25 changed files with 890 additions and 1029 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1436
racket/syndicate/actor.rkt
View File

File diff suppressed because it is too large Load Diff

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

@ -121,7 +121,7 @@
[_ #f]))
(run-ground (spawn-timer-driver)
(spawn-websocket-driver)
(dataspace (perform-core-action! (spawn-broker-server 8000))
(dataspace (schedule-action! (spawn-broker-server 8000))
(when ssl-options
(perform-core-action! (spawn-broker-server 8443 #:ssl-options ssl-options)))
(schedule-action! (spawn-broker-server 8443 #:ssl-options ssl-options)))
(forever))))

12
racket/syndicate/examples/actor/bank-account.rkt
View File

@ -6,13 +6,13 @@
(struct account (balance) #:prefab)
(struct deposit (amount) #:prefab)
(actor (forever #:collect [(balance 0)]
(assert (account balance))
(on (message (deposit $amount))
(+ balance amount))))
(actor (react (field [balance 0])
(assert (account (balance)))
(on (message (deposit $amount))
(balance (+ (balance) amount)))))
(actor (forever (on (asserted (account $balance))
(printf "Balance changed to ~a\n" balance))))
(actor (react (on (asserted (account $balance))
(printf "Balance changed to ~a\n" balance))))
(actor (until (asserted (observe (deposit _))))
(send! (deposit +100))

20
racket/syndicate/examples/actor/box-and-client.rkt
View File

@ -6,12 +6,16 @@
(struct set-box (new-value) #:transparent)
(struct box-state (value) #:transparent)
(actor (forever #:collect [(current-value 0)]
(assert (box-state current-value))
(on (message (set-box $new-value))
(log-info "box: taking on new-value ~v" new-value)
new-value)))
(actor (react (field [current-value 0])
(assert (box-state (current-value)))
(stop-when (rising-edge (= (current-value) 10))
(log-info "box: terminating"))
(on (message (set-box $new-value))
(log-info "box: taking on new-value ~v" new-value)
(current-value new-value))))
(actor (forever (on (asserted (box-state $v))
(log-info "client: learned that box's value is now ~v" v)
(send! (set-box (+ v 1))))))
(actor (react (stop-when (retracted (observe (set-box _)))
(log-info "client: box has gone"))
(on (asserted (box-state $v))
(log-info "client: learned that box's value is now ~v" v)
(send! (set-box (+ v 1))))))

8
racket/syndicate/examples/actor/broadcast-messages.rkt
View File

@ -5,11 +5,11 @@
(struct envelope (destination message) #:prefab)
(actor (forever (on (message (envelope 'alice $message))
(log-info "Alice received ~v" message))))
(actor (react (on (message (envelope 'alice $message))
(log-info "Alice received ~v" message))))
(actor (forever (on (message (envelope 'bob $message))
(log-info "Bob received ~v" message))))
(actor (react (on (message (envelope 'bob $message))
(log-info "Bob received ~v" message))))
(actor
(log-info "Waiting for Alice and Bob.")

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

@ -8,7 +8,7 @@
(define (sleep sec)
(define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
(define (chain-step n)
(printf "chain-step ~v\n" n)

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

@ -10,13 +10,15 @@
(spawn-tcp-driver)
(forever (on (message (external-event stdin-evt (list $line)) #:meta-level 1)
(if (eof-object? line)
(return!)
(send! (tcp-channel local-handle remote-handle line))))
(actor
(react/suspend (quit)
(on (message (external-event stdin-evt (list $line)) #:meta-level 1)
(if (eof-object? line)
(quit)
(send! (tcp-channel local-handle remote-handle line))))
(assert (advertise (tcp-channel local-handle remote-handle _)))
(on (retracted (advertise (tcp-channel remote-handle local-handle _))) (return!))
(on (message (tcp-channel remote-handle local-handle $bs))
(write-bytes bs)
(flush-output)))
(assert (advertise (tcp-channel local-handle remote-handle _)))
(on (retracted (advertise (tcp-channel remote-handle local-handle _))) (quit))
(on (message (tcp-channel remote-handle local-handle $bs))
(write-bytes bs)
(flush-output))))

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

@ -31,6 +31,7 @@
(spawn-tcp-driver)
(define us (tcp-listener 5999))
(forever (assert (advertise (observe (tcp-channel _ us _))))
(on (asserted (advertise (tcp-channel $them us _)))
(spawn-session them us)))
(actor
(forever (assert (advertise (observe (tcp-channel _ us _))))
(on (asserted (advertise (tcp-channel $them us _)))
(spawn-session them us))))

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

@ -40,13 +40,13 @@
(actor (forever (assert (advertise (observe (tcp-channel _ us _))))
(on (asserted (advertise (tcp-channel $them us _)))
(define id (seal (list them us)))
(actor (state [(assert (tcp-remote-open id))
(on (message (tcp-channel them us $bs))
(send! (tcp-incoming-data id bs)))
(on (message (tcp-outgoing-data id $bs))
(send! (tcp-channel us them bs)))]
[(retracted (advertise (tcp-channel them us _))) (void)]
[(retracted (tcp-local-open id)) (void)])))))
(actor (react (stop-when (retracted (advertise (tcp-channel them us _))))
(stop-when (retracted (tcp-local-open id)))
(assert (tcp-remote-open id))
(on (message (tcp-channel them us $bs))
(send! (tcp-incoming-data id bs)))
(on (message (tcp-outgoing-data id $bs))
(send! (tcp-channel us them bs))))))))
(forever (on (asserted (tcp-remote-open $id))
(spawn-session id)))
(actor (forever (on (asserted (tcp-remote-open $id))
(spawn-session id))))

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

@ -6,11 +6,11 @@
(spawn-tcp-driver)
(define server-id (tcp-listener 5999))
(forever (assert (advertise (observe (tcp-channel _ server-id _))))
(on (asserted (advertise (tcp-channel $c server-id _)))
(printf "Accepted connection from ~v\n" c)
(actor (until (retracted (advertise (tcp-channel c server-id _)))
(assert (advertise (tcp-channel server-id c _)))
(on (message (tcp-channel c server-id $bs))
(send! (tcp-channel server-id c bs))))
(printf "Closed connection ~v\n" c))))
(actor
(forever (assert (advertise (observe (tcp-channel _ server-id _))))
(during/actor (advertise (tcp-channel $c server-id _))
(on-start (printf "Accepted connection from ~v\n" c))
(assert (advertise (tcp-channel server-id c _)))
(on (message (tcp-channel c server-id $bs))
(send! (tcp-channel server-id c bs)))
(on-stop (printf "Closed connection ~v\n" c)))))

9
racket/syndicate/examples/actor/example-during-criterion-snapshotting.rkt
View File

@ -19,9 +19,10 @@
(struct foo (x y) #:prefab)
(actor (define x 123)
(forever
(react
(assert (foo x 999))
(during (foo x $v)
#:init [(log-info "x=~a v=~a" x v)
(when (= x 123) (set! x 124))]
#:done [(log-info "finally for x=~a v=~a" x v)])))
(log-info "x=~a v=~a" x v)
(when (= x 123) (set! x 124))
(on-stop
(log-info "finally for x=~a v=~a" x v)))))

17
racket/syndicate/examples/actor/example-partial-retraction.rkt
View File

@ -7,7 +7,7 @@
(struct ready (what) #:prefab)
(struct entry (key val) #:prefab)
(actor (forever
(actor (react
(assert (ready 'listener))
(on (asserted (entry $key _))
(log-info "key ~v asserted" key)
@ -18,19 +18,20 @@
(log-info "del binding: ~v -> ~v" key value)))
(log-info "key ~v retracted" key))))
(actor (forever
(actor (react
(assert (ready 'other-listener))
(during (entry $key _)
#:init [(log-info "(other-listener) key ~v asserted" key)]
#:done [(log-info "(other-listener) key ~v retracted" key)]
(log-info "(other-listener) key ~v asserted" key)
(on-stop (log-info "(other-listener) key ~v retracted" key))
(during (entry key $value)
#:init [(log-info "(other-listener) ~v ---> ~v" key value)]
#:done [(log-info "(other-listener) ~v -/-> ~v" key value)]))))
(log-info "(other-listener) ~v ---> ~v" key value)
(on-stop (log-info "(other-listener) ~v -/-> ~v" key value))))))
(define (pause)
(log-info "pause")
(until (asserted (ready 'pause))
(assert (ready 'pause))))
(define token (gensym 'pause)) ;; FIXME:: If we use the same token every time, need epochs!
(until (asserted (ready token))
(assert (ready token))))
(actor (until (asserted (ready 'listener)))
(until (asserted (ready 'other-listener)))

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

@ -13,21 +13,21 @@
(spawn-timer-driver)
(actor (forever #:collect [(files (hash))]
(during (observe (file $name _))
#:init [(printf "At least one reader exists for ~v\n" name)]
#:done [(printf "No remaining readers exist for ~v\n" name)]
#:collect [(content (hash-ref files name #f))]
(assert (file name content))
(on (message (save (file name $content))) content)
(on (message (delete name)) #f))
(on (message (save (file $name $content))) (hash-set files name content))
(on (message (delete $name)) (hash-remove files name))))
(actor (react (field [files (hash)])
(during (observe (file $name _))
(on-start (printf "At least one reader exists for ~v\n" name))
(on-stop (printf "No remaining readers exist for ~v\n" name))
(field [content (hash-ref (files) name #f)])
(assert (file name (content)))
(on (message (save (file name $new-content))) (content new-content))
(on (message (delete name)) (content #f)))
(on (message (save (file $name $content))) (files (hash-set (files) name content)))
(on (message (delete $name)) (files (hash-remove (files) name)))))
(define (sleep sec)
(define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
;; Shell
(let ((e (read-bytes-line-evt (current-input-port) 'any)))

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

@ -58,7 +58,7 @@
(define (sleep sec)
(define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
;; Shell
(let ((e (read-bytes-line-evt (current-input-port) 'any)))

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

@ -59,7 +59,7 @@
(define (sleep sec)
(define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
;; Shell
(let ((e (read-bytes-line-evt (current-input-port) 'any)))

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

@ -13,22 +13,22 @@
(spawn-timer-driver)
(actor (forever #:collect [(files (hash))]
(on (asserted (observe (file $name _)))
(printf "At least one reader exists for ~v\n" name)
(begin0 (until (retracted (observe (file name _)))
#:collect [(content (hash-ref files name #f))]
(assert (file name content))
(on (message (save (file name $content))) content)
(on (message (delete name)) #f))
(printf "No remaining readers exist for ~v\n" name)))
(on (message (save (file $name $content))) (hash-set files name content))
(on (message (delete $name)) (hash-remove files name))))
(actor (react (field [files (hash)])
(on (asserted (observe (file $name _)))
(printf "At least one reader exists for ~v\n" name)
(begin0 (until (retracted (observe (file name _)))
(field [content (hash-ref (files) name #f)])
(assert (file name (content)))
(on (message (save (file name $new-content))) (content new-content))
(on (message (delete name)) (content #f)))
(printf "No remaining readers exist for ~v\n" name)))
(on (message (save (file $name $content))) (files (hash-set (files) name content)))
(on (message (delete $name)) (files (hash-remove (files) name)))))
(define (sleep sec)
(define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
;; Shell
(let ((e (read-bytes-line-evt (current-input-port) 'any)))

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

@ -14,30 +14,30 @@
(spawn-timer-driver)
(actor (forever #:collect [(files (hash)) (monitored (set))]
(on (asserted (observe (file $name _)))
(printf "At least one reader exists for ~v\n" name)
(assert! (file name (hash-ref files name #f)))
(values files (set-add monitored name)))
(on (retracted (observe (file $name _)))
(printf "No remaining readers exist for ~v\n" name)
(retract! (file name (hash-ref files name #f)))
(values files (set-remove monitored name)))
(on (message (save (file $name $content)))
(when (set-member? monitored name)
(retract! (file name (hash-ref files name #f)))
(assert! (file name content)))
(values (hash-set files name content) monitored))
(on (message (delete $name))
(when (set-member? monitored name)
(retract! (file name (hash-ref files name #f)))
(assert! (file name #f)))
(values (hash-remove files name) monitored))))
(actor (react (field [files (hash)] [monitored (set)])
(on (asserted (observe (file $name _)))
(printf "At least one reader exists for ~v\n" name)
(assert! (file name (hash-ref (files) name #f)))
(monitored (set-add (monitored) name)))
(on (retracted (observe (file $name _)))
(printf "No remaining readers exist for ~v\n" name)
(retract! (file name (hash-ref (files) name #f)))
(monitored (set-remove (monitored) name)))
(on (message (save (file $name $content)))
(when (set-member? (monitored) name)
(retract! (file name (hash-ref (files) name #f)))
(assert! (file name content)))
(files (hash-set (files) name content)))
(on (message (delete $name))
(when (set-member? (monitored) name)
(retract! (file name (hash-ref (files) name #f)))
(assert! (file name #f)))
(files (hash-remove (files) name)))))
(define (sleep sec)
(define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
;; Shell
(let ((e (read-bytes-line-evt (current-input-port) 'any)))

18
racket/syndicate/examples/actor/forward-chaining-mini.rkt
View File

@ -3,17 +3,17 @@
(require syndicate/actor)
(actor (forever (assert `(parent john douglas))))
(actor (forever (assert `(parent bob john))))
(actor (forever (assert `(parent ebbon bob))))
(actor (react (assert `(parent john douglas))))
(actor (react (assert `(parent bob john))))
(actor (react (assert `(parent ebbon bob))))
;; This looks like an implication:
;; (parent A C) ⇒ ((ancestor A C) ∧ ((ancestor C B) ⇒ (ancestor A B)))
;;
(actor (forever (during `(parent ,$A ,$C)
(assert `(ancestor ,A ,C))
(during `(ancestor ,C ,$B)
(assert `(ancestor ,A ,B))))))
(actor (react (during `(parent ,$A ,$C)
(assert `(ancestor ,A ,C))
(during `(ancestor ,C ,$B)
(assert `(ancestor ,A ,B))))))
(actor (forever (on (asserted `(ancestor ,$A ,$B))
(log-info "~a is an ancestor of ~a" A B))))
(actor (react (on (asserted `(ancestor ,$A ,$B))
(log-info "~a is an ancestor of ~a" A B))))

12
racket/syndicate/examples/actor/mini-echo.rkt
View File

@ -5,13 +5,13 @@
(struct echo-req (body) #:prefab)
(struct echo-resp (body) #:prefab)
(actor (forever #:collect [(count 0)]
(on (message (echo-req $body))
(send! (echo-resp body))
(+ count 1))))
(actor (react (field [count 0])
(on (message (echo-req $body))
(send! (echo-resp body))
(count (+ (count) 1)))))
(actor (forever (on (message (echo-resp $body))
(printf "Received: ~v\n" body))))
(actor (react (on (message (echo-resp $body))
(printf "Received: ~v\n" body))))
(actor (until (asserted (observe (echo-req _))))
(until (asserted (observe (echo-resp _))))

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

@ -24,26 +24,28 @@
[(cons a d) (set-union (walk a) (walk d))]
[_ (set)])))
(define (non-void? v) (not (void? v)))
(define (non-void-field? f) (not (void? (f))))
(define (cell-expr->actor-expr name expr)
(define bindings (set->list (extract-bindings expr)))
`(actor (until (message (set-cell ',name _))
#:collect [,@(for/list [(b bindings)] `(,b (void)))]
(assert #:when (andmap non-void? (list ,@bindings)) (cell ',name ,expr))
(field ,@(for/list [(b bindings)] `[,b (void)]))
(assert #:when (andmap non-void-field? (list ,@bindings))
(cell ',name
(let (,@(for/list [(b bindings)] `(,b (,b))))
,expr)))
,@(for/list [(b bindings)]
`(on (asserted (cell ',b $value))
(values ,@(for/list [(b1 bindings)]
(if (eq? b b1) 'value b1))))))))
(,b value))))))
(actor (forever (on (message (set-cell $name $expr))
(define actor-expr (cell-expr->actor-expr name expr))
;; (local-require racket/pretty) (pretty-print actor-expr)
(eval actor-expr (namespace-anchor->namespace ns)))))
(actor (react (on (message (set-cell $name $expr))
(define actor-expr (cell-expr->actor-expr name expr))
;; (local-require racket/pretty) (pretty-print actor-expr)
(eval actor-expr (namespace-anchor->namespace ns)))))
(actor (forever (on (asserted (cell $name $value))
(printf ">>> ~a ~v\n" name value)
(flush-output))))
(actor (react (on (asserted (cell $name $value))
(printf ">>> ~a ~v\n" name value)
(flush-output))))
(actor (void (thread (lambda ()
(let loop ()

128
racket/syndicate/examples/actor/two-buyer-protocol.rkt
View File

@ -3,6 +3,8 @@
;; given in Honda/Yoshida/Carbone 2008, "Multiparty Asynchronous
;; Session Types".
;; TODO:: code this up in Syndicate/js. See whether the killing-child-facets problems exists there.
;; SAMPLE OUTPUT:
;;---------------------------------------------------------------------------
;; A learns that the price of "Catch 22" is 2.22
@ -89,38 +91,43 @@
;; SELLER
;;
(define (seller)
(actor (forever #:collect [(books (hash "The Wind in the Willows" 3.95
"Catch 22" 2.22
"Candide" 34.95))
(next-order-id 10001483)]
(actor (react (field [books (hash "The Wind in the Willows" 3.95
"Catch 22" 2.22
"Candide" 34.95)]
[next-order-id 10001483])
;; Give quotes to interested parties.
;;
(during (observe (book-quote $title _))
(assert (book-quote title (hash-ref books title #f))))
;; Give quotes to interested parties.
;;
(during (observe (book-quote $title _))
(assert (book-quote title (hash-ref (books) title #f))))
;; Respond to order requests.
;;
(on (asserted (observe (order $title $offer-price _ _)))
(define asking-price (hash-ref books title #f))
(cond
;; Respond to order requests.
;;
(on (asserted (observe (order $title $offer-price _ _)))
(define asking-price (hash-ref (books) title #f))
(cond
[(or (not asking-price) (< offer-price asking-price))
;; We cannot sell a book we do not have, and we will not sell for less
;; than our asking price.
;;
(while-relevant-assert (order title offer-price #f #f))]
[(or (not asking-price) (< offer-price asking-price))
;; We cannot sell a book we do not have, and we will not sell for less
;; than our asking price.
;;
(while-relevant-assert (order title offer-price #f #f))]
[else
;; Tell the ordering party their order ID and delivery date.
;;
(actor
(while-relevant-assert
(order title offer-price next-order-id "March 9th")))
[else
;; Allocate an order ID.
;;
(define order-id (next-order-id))
(next-order-id (+ order-id 1))
;; Remove the book from our shelves, and increment our order ID.
;;
(values (hash-remove books title) (+ next-order-id 1))])))))
;; Remove the book from our shelves.
;;
(books (hash-remove (books) title))
;; Tell the ordering party their order ID and delivery date.
;;
(actor
(while-relevant-assert
(order title offer-price order-id "March 9th")))])))))
;; Serial SPLIT-PROPOSER
;;
@ -136,7 +143,8 @@
;; First, retrieve a quote for the title, and analyze the result.
;;
(match (state [] [(asserted (book-quote title $price)) price])
(match (react/suspend (yield)
(stop-when (asserted (book-quote title $price)) (yield price)))
[#f
(log-info "A learns that ~v is out-of-stock." title)
(try-to-buy remaining-titles)]
@ -161,31 +169,14 @@
[else
;; Make our proposal, and wait for a response.
;; SEE NOTE (A).
;;
(match (state [] [(asserted (split-proposal title price contribution $accepted?))
accepted?])
[#t
(log-info "A learns that the split-proposal for ~v was accepted" title)
(try-to-buy remaining-titles)]
[#f
(log-info "A learns that the split-proposal for ~v was rejected" title)
;; Offer to contribute a little more.
(try-to-split (+ contribution (/ (- price contribution) 2)))])]))])]))
;; NOTE (A): Wrote this originally where the anchor to this note is found. The code here
;; doesn't release assertions properly; we fall foul of the "run the continuation clauses
;; while the subscriptions are still active" property of the current actor.rkt
;; implementation.
;;
;; (state []
;; [(asserted (split-proposal title price contribution #t))
;; (log-info "A learns that the split-proposal for ~v was accepted" title)
;; (try-to-buy remaining-titles)]
;; [(asserted (split-proposal title price contribution #f))
;; (log-info "A learns that the split-proposal for ~v was rejected" title)
;; (try-to-split (+ contribution (/ (- price contribution) 2)))])
;;
(react
(stop-when (asserted (split-proposal title price contribution #t))
(log-info "A learns that the split-proposal for ~v was accepted" title)
(try-to-buy remaining-titles))
(stop-when (asserted (split-proposal title price contribution #f))
(log-info "A learns that the split-proposal for ~v was rejected" title)
(try-to-split (+ contribution (/ (- price contribution) 2)))))]))])]))
(actor (try-to-buy (list "Catch 22"
"Encyclopaedia Brittannica"
@ -195,11 +186,11 @@
;; Serial SPLIT-DISPOSER
;;
(define (buyer-b)
(actor (forever
(actor (react
;; This actor maintains a record of the amount of money it has to spend.
;;
#:collect [(funds 5.00)]
(field [funds 5.00])
(on (asserted (observe (split-proposal $title $price $their-contribution _)))
@ -210,8 +201,8 @@
price)
(cond
[(> my-contribution funds)
(log-info "B hasn't enough funds (~a remaining)" funds)
[(> my-contribution (funds))
(log-info "B hasn't enough funds (~a remaining)" (funds))
(while-relevant-assert (split-proposal title price their-contribution #f))]
[else
@ -221,16 +212,17 @@
;; actual purchase now that we have agreed on a split.
;;
(actor (define-values (order-id delivery-date)
(state
[;; While we are in this state, waiting for order confirmation, take
;; the opportunity to signal to our SPLIT-PROPOSER that we accepted
;; their proposal.
;;
(assert (split-proposal title price their-contribution #t))]
[(asserted (order title price $id $date))
;; We have received order confirmation from the SELLER.
;;
(values id date)]))
(react/suspend (yield)
;; While we are in this state, waiting for order confirmation, take
;; the opportunity to signal to our SPLIT-PROPOSER that we accepted
;; their proposal.
;;
(assert (split-proposal title price their-contribution #t))
(stop-when (asserted (order title price $id $date))
;; We have received order confirmation from the SELLER.
;;
(yield id date))))
(log-info "The order for ~v has id ~a, and will be delivered on ~a"
title
order-id
@ -239,10 +231,10 @@
;; Meanwhile, update our records of our available funds, and continue to wait
;; for more split-proposals to arrive.
;;
(define remaining-funds (- funds my-contribution))
(define remaining-funds (- (funds) my-contribution))
(log-info "B accepts the offer, leaving them with ~a remaining funds"
remaining-funds)
remaining-funds])))))
(funds remaining-funds)])))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -29,18 +29,18 @@
(assert (path A C (+ link-cost path-cost)))))))
(actor (forever (during (path-exists $from $to)
#:collect [(costs (set)) (least +inf.0)]
(assert (min-cost from to least))
(field [costs (set)] [least +inf.0])
(assert (min-cost from to (least)))
(on (asserted (path from to $cost))
(values (set-add costs cost)
(min least cost)))
(costs (set-add (costs) cost))
(least (min (least) cost)))
(on (retracted (path from to $cost))
(define new-costs (set-remove costs cost))
(values new-costs
(for/fold [(least +inf.0)] [(x new-costs)] (min x least)))))))
(define new-costs (set-remove (costs) cost))
(costs new-costs)
(least (for/fold [(least +inf.0)] [(x new-costs)] (min x least)))))))
;; (actor (forever (during (path $from $to $cost)
;; #:init [(displayln `(+ ,(path from to cost)))]
;; #:done [(displayln `(- ,(path from to cost)))])))
;; (on-start (displayln `(+ ,(path from to cost))))
;; (on-stop (displayln `(- ,(path from to cost)))))))
(actor (forever (on (asserted (min-cost $from $to $cost))
(displayln (min-cost from to cost)))))

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

@ -29,18 +29,18 @@
(path A C (set-add seen A) (+ link-cost path-cost)))))))
(actor (forever (during (path-exists $from $to)
#:collect [(costs (set)) (least +inf.0)]
(assert (min-cost from to least))
(field [costs (set)] [least +inf.0])
(assert (min-cost from to (least)))
(on (asserted (path from to _ $cost))
(values (set-add costs cost)
(min least cost)))
(costs (set-add (costs) cost))
(least (min (least) cost)))
(on (retracted (path from to _ $cost))
(define new-costs (set-remove costs cost))
(values new-costs
(for/fold [(least +inf.0)] [(x new-costs)] (min x least)))))))
(define new-costs (set-remove (costs) cost))
(costs new-costs)
(least (for/fold [(least +inf.0)] [(x new-costs)] (min x least)))))))
(actor (forever (during (path $from $to $seen $cost)
#:init [(displayln `(+ ,(path from to seen cost)))]
#:done [(displayln `(- ,(path from to seen cost)))])))
(on-start (displayln `(+ ,(path from to seen cost))))
(on-stop (displayln `(- ,(path from to seen cost)))))))
(actor (forever (on (asserted (min-cost $from $to $cost))
(displayln (min-cost from to cost)))))

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

@ -7,7 +7,10 @@
(require syndicate/actor)
(require racket/port)
(match-define (vector url) (current-command-line-arguments))
(define url
(match (current-command-line-arguments)
[(vector url) url]
[(vector) "http://localhost:8081/ws-echo"]))
(spawn-websocket-driver)
@ -19,14 +22,15 @@
(define (generate-reader-id)
(begin0 reader-count
(set! reader-count (+ reader-count 1))))
(actor (state [(assert (advertise (websocket-message c s _)))
(on (asserted (websocket-peer-details c s $la _ $ra _))
(log-info "~a: local ~v :: remote ~v" c la ra))
(on (message (external-event e (list (? bytes? $bs))) #:meta-level 1)
(send! (websocket-message c s bs)))
(on (message (websocket-message s c $bs))
(printf "(From server: ~v)\n" bs))]
[(message (external-event e (list (? eof-object? _))) #:meta-level 1)
(printf "Local EOF. Terminating.\n")]
[(retracted (advertise (websocket-message s c _)))
(printf "Server disconnected.\n")])))
(actor (react (assert (advertise (websocket-message c s _)))
(on (asserted (websocket-peer-details c s $la _ $ra _))
(log-info "~a: local ~v :: remote ~v" c la ra))
(on (message (external-event e (list (? bytes? $bs))) #:meta-level 1)
(send! (websocket-message c s bs)))
(on (message (websocket-message s c $bs))
(printf "(From server: ~v)\n" bs))
(stop-when (message (external-event e (list (? eof-object? _)))
#:meta-level 1)
(printf "Local EOF. Terminating.\n"))
(stop-when (retracted (advertise (websocket-message s c _)))
(printf "Server disconnected.\n")))))

12
racket/syndicate/support/dsl.rkt
View File

@ -1,12 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
(provide define&provide-dsl-helper-syntaxes)
(define-for-syntax (illegal-use id context stx)
(raise-syntax-error #f (format "Illegal use of ~a outside ~a" id context) stx))
(define-syntax-rule (define&provide-dsl-helper-syntaxes context (identifier ...))
(begin (provide identifier ...)
(define-syntax (identifier stx) (illegal-use 'identifier context stx))
...))