From d0d7e677fea1dec53f8371943ef86a686efb08b6 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 29 Nov 2016 14:55:47 +1300 Subject: [PATCH] Reevaluate supervisor name expression for each supervisee --- racket/syndicate/supervise.rkt | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/racket/syndicate/supervise.rkt b/racket/syndicate/supervise.rkt index 804d781..b162671 100644 --- a/racket/syndicate/supervise.rkt +++ b/racket/syndicate/supervise.rkt @@ -19,19 +19,18 @@ (syntax-parse stx [(_ name:actor-name expr ...) (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 ;; produced by actor spawns in actor-producing-thunk. (with-store [(current-action-transformer - (supervise-spawn (or supervisor-name (gensym 'supervisor)) - (current-action-transformer)))] + (supervise-spawn supervisor-name-thunk (current-action-transformer)))] (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) - [(? spawn? s) (supervise** supervisor-name s)] + [(? spawn? s) (supervise** (or (supervisor-name-thunk) (gensym 'supervisor)) s)] [other other])) (define (supervise** supervisor-name supervisee-spawn-action)