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

during/spawn

This commit is contained in:
Tony Garnock-Jones 2018-04-22 21:07:35 +01:00
parent 1523ef17cf
commit e6d6f67021
2 changed files with 126 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
syndicate/pattern.rkt
View File

@ -4,7 +4,8 @@
(struct-out capture)
(for-syntax analyse-pattern
instantiate-pattern
instantiate-pattern->pattern
instantiate-pattern->value
desc->key
desc->skeleton-proj
desc->skeleton-stx
@ -78,14 +79,14 @@
[_
(list 'atom stx)]))
(define (instantiate-pattern stx)
(define (instantiate-pattern->pattern stx)
(syntax-case stx ($)
[(ctor piece ...)
(struct-info? (id-value #'ctor))
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern #'(piece ...))))]
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
[(list piece ...)
(list-id? #'list)
(quasisyntax/loc stx (list #,@(stx-map instantiate-pattern #'(piece ...))))]
(quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
[id
(dollar-id? #'id)
(undollar #'id)]
@ -94,6 +95,25 @@
[id
(discard-id? #'id)
#'id]
[other
#'other]))
(define (instantiate-pattern->value stx)
(syntax-case stx ($)
[(ctor piece ...)
(struct-info? (id-value #'ctor))
(quasisyntax/loc stx (ctor #,@(stx-map instantiate-pattern->value #'(piece ...))))]
[(list piece ...)
(list-id? #'list)
(quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->value #'(piece ...))))]
[id
(dollar-id? #'id)
(undollar #'id)]
[($ id p)
#'id]
[id
(discard-id? #'id)
#'(discard)]
[other
#'other])))

146
syndicate/syntax.rkt
View File

@ -18,7 +18,7 @@
on-stop
on
during
;; during/spawn
during/spawn
begin/dataflow
define/dataflow
@ -69,6 +69,7 @@
(require racket/set)
(require syndicate/dataflow)
(require syndicate/protocol/instance)
(begin-for-syntax
(define-splicing-syntax-class actor-wrapper
@ -363,53 +364,51 @@
(define-syntax (during stx)
(syntax-parse stx
[(_ P O ...)
(define Q-stx (instantiate-pattern #'P))
(quasisyntax/loc stx
(on (asserted P)
(react (stop-when (retracted #,Q-stx))
(react (stop-when (retracted #,(instantiate-pattern->pattern #'P)))
O ...)))]))
;; (define-syntax (during/spawn stx)
;; (syntax-parse stx
;; [(_ P w:actor-wrapper name:name assertions:assertions parent-let:let-option
;; oncrash:on-crash-option
;; O ...)
;; (define E-stx (syntax/loc #'P (asserted P)))
;; (define-values (_proj _pat _bindings instantiated)
;; (analyze-pattern E-stx #'P))
;; (quasisyntax/loc stx
;; (on #,E-stx
;; (let* ((id (gensym 'during/spawn))
;; (p #,instantiated) ;; this is the concrete assertion corresponding to demand
;; (inst (instance id p))) ;; this is the assertion representing supply
;; (react (stop-when (asserted inst)
;; ;; Supply (inst) appeared before demand (p) retracted.
;; ;; Transition to a state where we monitor demand, but also
;; ;; express interest in supply: this latter acts as a signal
;; ;; to the supply that it should stick around. We react to
;; ;; retraction of supply before retraction of demand by
;; ;; invoking the on-crash expression, if supplied. Once
;; ;; demand is retracted, this facet terminates, retracting
;; ;; its interest in supply, thereby signalling to the supply
;; ;; that it is no longer wanted.
;; (react (stop-when (retracted inst) ;; NOT OPTIONAL
;; #,@(if (attribute oncrash.expr)
;; #'(oncrash.expr)
;; #'()))
;; (stop-when (retracted p))))
;; (stop-when (retracted p)
;; ;; Demand (p) retracted before supply (inst) appeared. We
;; ;; MUST wait for the supply to fully appear so that we can
;; ;; reliably tell it to shut down. We must maintain interest
;; ;; in supply until we see supply, and then terminate, thus
;; ;; signalling to supply that it is no longer wanted.
;; (react (stop-when (asserted inst)))))
;; (let parent-let.clauses
;; (w.wrapper #:linkage [(assert inst)
;; (stop-when (retracted (observe inst)))]
;; #:name name.N
;; #:assertions* assertions.P
;; O ...)))))]))
(define-syntax (during/spawn stx)
(syntax-parse stx
[(_ P w:actor-wrapper name:name assertions:assertions parent-let:let-option
oncrash:on-crash-option
O ...)
(define Q-stx (instantiate-pattern->pattern #'P))
(quasisyntax/loc stx
(on (asserted P)
(let* ((id (gensym 'during/spawn))
(inst (instance id #,(instantiate-pattern->value #'P)))
;; ^ this is the assertion representing supply
)
(react (stop-when (asserted inst)
;; Supply (inst) appeared before demand (p) retracted.
;; Transition to a state where we monitor demand, but also
;; express interest in supply: this latter acts as a signal
;; to the supply that it should stick around. We react to
;; retraction of supply before retraction of demand by
;; invoking the on-crash expression, if supplied. Once
;; demand is retracted, this facet terminates, retracting
;; its interest in supply, thereby signalling to the supply
;; that it is no longer wanted.
(react (stop-when (retracted inst) ;; NOT OPTIONAL
#,@(if (attribute oncrash.expr)
#'(oncrash.expr)
#'()))
(stop-when (retracted #,Q-stx))))
(stop-when (retracted #,Q-stx)
;; Demand (p) retracted before supply (inst) appeared. We
;; MUST wait for the supply to fully appear so that we can
;; reliably tell it to shut down. We must maintain interest
;; in supply until we see supply, and then terminate, thus
;; signalling to supply that it is no longer wanted.
(react (stop-when (asserted inst)))))
(let parent-let.clauses
(w.wrapper #:linkage [(assert inst)
(stop-when (retracted (observe inst)))]
#:name name.N
#:assertions [assertions.exprs ...]
O ...)))))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Queries
@ -614,6 +613,65 @@
)
(lambda ()
(spawn #:name 'factory-1
(on (asserted (list 'X 1))
(spawn #:name 'service-1
#:assertions [(observe (list 'X 1))] ;; (A)
(stop-when (retracted (list 'X 1))) ;; (B)
(on (message 'dummy))) ;; exists just to keep the service alive if
;; there are no other endpoints
;; spawn executes *before* teardown of this on-asserted endpoint, and thus
;; before the patch withdrawing (observe (list 'X 1)).
(stop-current-facet)))
(spawn (on (asserted (observe (list 'X $supplier)))
(printf "Supply ~v asserted.\n" supplier)
(assert! (list 'X supplier)))
(on (retracted (observe (list 'X $supplier)))
(printf "Supply ~v retracted.\n" supplier)))
)
#;(lambda ()
(spawn #:name 'demand-watcher
(during/spawn 'demand
#:name (gensym 'intermediate-demand-asserter)
(assert 'intermediate-demand)))
(spawn #:name 'intermediate-demand-watcher
(during/spawn 'intermediate-demand
#:name (gensym 'supply-asserter)
(assert 'supply)))
(spawn* #:name 'driver
(react (on (asserted 'supply) (log-info "Supply asserted."))
(on (retracted 'supply) (log-info "Supply retracted.")))
(until (asserted (observe 'demand)))
(log-info "Asserting demand.")
(assert! 'demand)
(until (asserted 'supply))
(log-info "Glitching demand.")
(retract! 'demand)
(flush!)
(assert! 'demand)
(log-info "Demand now steady."))
)
#;(lambda ()
;; Trivial example program to demonstrate tracing
(assertion-struct one-plus (n m))
(spawn #:name 'add1-server
(during/spawn (observe (one-plus $n _))
#:name (list 'solving 'one-plus n)
(assert (one-plus n (+ n 1)))))
(spawn #:name 'client-process
(stop-when (asserted (one-plus 3 $value))
(printf "1 + 3 = ~a\n" value)))
)
#;(lambda ()
;; .../racket/syndicate/examples/actor/example-partial-retraction.rkt
;;
(struct ready (what) #:prefab)