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

Treat #:message separately from #:asserted. 

While in principle messages are "instantaneous" assertions, it invites
confusion to treat them as such in context of `(object)` because
assertions by default spawn nested facets, so it's too easy to
accidentally wrap a message handler in an unwanted facet. Being
explicit about messages means you never get an unwanted facet wrapper.
This commit is contained in:
Tony Garnock-Jones 2021-06-15 12:41:46 +02:00
parent d23e264756
commit 0b1e9874d1
3 changed files with 36 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt
View File

@ -19,7 +19,7 @@
'setter
(embedded
(object #:name 'update-handler
[#:asserted new-value
[#:message new-value
(reporter new-value)
(when (= new-value LIMIT) (stop-facet root-facet))
(value new-value)]))))))
@ -49,7 +49,7 @@
(define root-facet this-facet)
(define disarm (facet-prevent-inert-check! this-facet))
(box (object #:name 'box-boot-handler
[#:asserted refs
[#:message refs
(log-info "refs ~v" refs)
(match-define (hash-table ('getter (embedded g))
('setter (embedded s))) refs)

18
syndicate/drivers/tcp.rkt
View File

@ -75,9 +75,9 @@
(at local-peer
(assert (ActiveSocket-controller
(object #:name (list name 'socket)
[#:asserted (Socket-credit amount mode) (issue-credit amount mode)]
[#:asserted (Socket-data data mode) (relay data mode)]
[#:asserted (Socket-eof) (close-output-port o)]))))))))
[#:message (Socket-credit amount mode) (issue-credit amount mode)]
[#:message (Socket-data data mode) (relay data mode)]
[#:message (Socket-eof) (close-output-port o)]))))))))
(define (spawn-inbound ds custodian i o spec)
(define name (call-with-values (lambda () (tcp-addresses i #t)) list))
@ -104,14 +104,14 @@
[#:asserted (ActiveSocket-close message)
(log-syndicate/drivers/tcp-debug "closing ~v:\n~a" this-actor message)
(stop-current-facet)]
[#:asserted (ActiveSocket-Socket (Socket-credit amount mode))
[#:message (ActiveSocket-Socket (Socket-credit amount mode))
(if issue-credit
(issue-credit amount mode)
(log-syndicate/drivers/tcp-warning
"Socket-credit ~v/~v ignored because no controller present" amount mode))]
[#:asserted (ActiveSocket-Socket (Socket-data data mode))
[#:message (ActiveSocket-Socket (Socket-data data mode))
(relay data mode)]
[#:asserted (ActiveSocket-Socket (Socket-eof))
[#:message (ActiveSocket-Socket (Socket-eof))
(close-output-port o)]))
(at ds
(assert (ConnectionPeer handle (TcpRemote (caddr name) (cadddr name))))
@ -246,9 +246,9 @@
#:retracted
(on-disconnected)]
[#:asserted (ActiveSocket-close message) (on-rejected message)]
[#:asserted (ActiveSocket-Socket (Socket-credit amount mode)) (on-credit amount mode)]
[#:asserted (ActiveSocket-Socket (Socket-data data mode)) (on-data data mode)]
[#:asserted (ActiveSocket-Socket (Socket-eof)) (on-eof)]))
[#:message (ActiveSocket-Socket (Socket-credit amount mode)) (on-credit amount mode)]
[#:message (ActiveSocket-Socket (Socket-data data mode)) (on-data data mode)]
[#:message (ActiveSocket-Socket (Socket-eof)) (on-eof)]))
(at ds (assert (Connection s spec))))
(define (send-credit conn amount mode)

38
syndicate/syntax.rkt
View File

@ -92,15 +92,15 @@
[(_ name-stx:<name> handler ...)
#`(let ((state (make-hash)))
(define name name-stx.N)
(define (handler-function assertion)
(-object-clauses name assertion [] [handler ...]))
(define (handler-function assertion is-message?)
(-object-clauses name assertion is-message? [] [handler ...]))
(ref (entity #:name name
#:assert (lambda (m h) (-object-assert state handler-function m h))
#:retract (lambda (h) (-object-retract state h))
#:message (lambda (m) (-object-message handler-function m)))))]))
(define (-object-assert state handler-function assertion handle)
(define k (handler-function assertion))
(define k (handler-function assertion #f))
(when k (hash-set! state handle k)))
(define (-object-retract state handle)
@ -110,44 +110,56 @@
(k)))
(define (-object-message handler-function message)
(define k (handler-function message))
(define k (handler-function message #t))
(when k
(k)))
(define-syntax (-object-clauses stx)
(syntax-parse stx
[(_ name input [completed ...] [])
[(_ name input is-message? [completed ...]
[])
#'(match input
completed ...
[_
(log-syndicate/object-debug "Unhandled assertion ~v in ~v" input name)
(log-syndicate/object-debug "Unhandled ~a ~v in ~v"
(if is-message? "message" "assertion")
input name)
#f])]
[(_ name input [completed ...] [ [#:spawn pat body ...] more ... ])
[(_ name input is-message? [completed ...]
[ [#:message pat body+ ...] more ... ])
#'(-object-clauses name
input
[completed ...]
[ [#:during pat (spawn/link body ...)] more ... ])]
is-message?
[ completed ... [(-object-pattern pat) #:when is-message?
body+ ... #f] ]
[more ...])]
[(_ name input [completed ...] [ [#:asserted pat body+ ... #:retracted body- ...] more ... ])
[(_ name input is-message? [completed ...]
[ [#:asserted pat body+ ... #:retracted body- ...] more ... ])
#`(-object-clauses name
input
[ completed ... [(-object-pattern pat)
is-message?
[ completed ... [(-object-pattern pat) #:when (not is-message?)
body+ ...
#,(if (null? (syntax->list #'(body- ...)))
#`#f
#`(lambda () body- ...))] ]
[more ...])]
[(_ name input [completed ...] [ [#:asserted pat body+ ...] more ... ])
[(_ name input is-message? [completed ...]
[ [#:asserted pat body+ ...] more ... ])
#'(-object-clauses name
input
is-message?
[completed ...]
[ [#:asserted pat body+ ... #:retracted] more ... ])]
[(_ name input [completed ...] [ [pat body ...] more ... ])
[(_ name input is-message? [completed ...]
[ [pat body ...] more ... ])
#'(-object-clauses name
input
is-message?
[completed ...]
[ [#:asserted pat
(define f (react (facet-prevent-inert-check! this-facet) body ...))