From 4dc40da0569e73cafb693d4c007004089f33e890 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 12 Jun 2021 22:16:59 +0200 Subject: [PATCH] Batch outbound actions per-actor, not per-facet; continue to retain ordering within a batch group --- syndicate/actor.rkt | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/syndicate/actor.rkt b/syndicate/actor.rkt index 780b520..0279a93 100644 --- a/syndicate/actor.rkt +++ b/syndicate/actor.rkt @@ -300,9 +300,23 @@ (set-facet-end-of-turn-actions! f '()) (for [(action (in-list pending))] (action)) (loop)))) - (for [((ff qq) (in-hash (turn-queues turn)))] - (queue-task! (actor-engine (facet-actor ff)) - (lambda () (turn! ff (lambda () (for [(a (in-list (reverse qq)))] (a))))))) + (for [((aa qq) (in-hash (turn-queues turn)))] + (queue-task! (actor-engine aa) + (lambda () + (define pending (reverse qq)) + (let loop () + (when (pair? pending) + (define ff (caar pending)) + (define action (cdar pending)) + (set! pending (cdr pending)) + (turn! ff (lambda () + (action) + (let inner () + (when (and (pair? pending) (eq? ff (caar pending))) + ((cdar pending)) + (set! pending (cdr pending)) + (inner))))) + (loop)))))) (set-turn-queues! turn #f))) (log-syndicate/actor-debug "end turn ~v\n" f))) @@ -315,7 +329,7 @@ (define qs (turn-queues turn)) (when (not qs) (error 'turn-enqueue! "Attempt to reuse ~a in ~a" turn (turn-active-facet turn))) - (hash-update! qs f (lambda (actions) (cons action actions)) '())) + (hash-update! qs (facet-actor f) (lambda (actions) (cons (cons f action) actions)) '())) (define (turn-ref turn entity [attenuation '()]) (entity-ref (turn-active-facet turn) entity attenuation))