Reevaluate supervisor name expression for each supervisee
This commit is contained in:
parent
d9cc478e6c
commit
d0d7e677fe
|
@ -19,19 +19,18 @@
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ name:actor-name expr ...)
|
[(_ name:actor-name expr ...)
|
||||||
(syntax/loc stx
|
(syntax/loc stx
|
||||||
(supervise* #:name name.N (lambda () expr ...)))]))
|
(supervise* (lambda () name.N) (lambda () expr ...)))]))
|
||||||
|
|
||||||
(define (supervise* #:name [supervisor-name #f] actor-producing-thunk)
|
(define (supervise* supervisor-name-thunk actor-producing-thunk)
|
||||||
;; Awkward: the name applies to any and all potential supervisors
|
;; Awkward: the name applies to any and all potential supervisors
|
||||||
;; produced by actor spawns in actor-producing-thunk.
|
;; produced by actor spawns in actor-producing-thunk.
|
||||||
(with-store [(current-action-transformer
|
(with-store [(current-action-transformer
|
||||||
(supervise-spawn (or supervisor-name (gensym 'supervisor))
|
(supervise-spawn supervisor-name-thunk (current-action-transformer)))]
|
||||||
(current-action-transformer)))]
|
|
||||||
(actor-producing-thunk)))
|
(actor-producing-thunk)))
|
||||||
|
|
||||||
(define ((supervise-spawn supervisor-name previous-action-transformer) ac)
|
(define ((supervise-spawn supervisor-name-thunk previous-action-transformer) ac)
|
||||||
(match (previous-action-transformer ac)
|
(match (previous-action-transformer ac)
|
||||||
[(? spawn? s) (supervise** supervisor-name s)]
|
[(? spawn? s) (supervise** (or (supervisor-name-thunk) (gensym 'supervisor)) s)]
|
||||||
[other other]))
|
[other other]))
|
||||||
|
|
||||||
(define (supervise** supervisor-name supervisee-spawn-action)
|
(define (supervise** supervisor-name supervisee-spawn-action)
|
||||||
|
|
Loading…
Reference in New Issue