From 463dd48577c0f890d43685202fb9bc08da46c3f7 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sun, 31 Jul 2016 12:02:11 -0400
Subject: [PATCH] Always pick the highest-priority script to run next.

This means that `*gc-priority*` scripts will now reliably run last.
Prior to this change, if some higher-priority script X ran while a
`*gc-priority*` script Y was queued, and it enqueued a high-priority
script Z, then Y would run before Z.
---
 racket/syndicate/actor.rkt | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/racket/syndicate/actor.rkt b/racket/syndicate/actor.rkt
index b84c297..80cb224 100644
--- a/racket/syndicate/actor.rkt
+++ b/racket/syndicate/actor.rkt
@@ -88,6 +88,7 @@
 (require "store.rkt")
 (require "support/hash.rkt")
 (require "pretty.rkt")
+(require "functional-queue.rkt")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Data Definitions and Structures
@@ -234,7 +235,7 @@
 ;; Storeof (Constreeof Action)
 (define current-pending-actions (make-store))
 
-;; Storeof (Vector (List Script) (List Script))
+;; Storeof (Vector (Queue Script) ...)
 ;; Mutates the vector!
 (define current-pending-scripts (make-store))
 
@@ -853,7 +854,7 @@
 
 (define (push-script! priority thunk-with-context)
   (define v (current-pending-scripts))
-  (vector-set! v priority (cons thunk-with-context (vector-ref v priority))))
+  (vector-set! v priority (enqueue (vector-ref v priority) thunk-with-context)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Action Queue Management
@@ -991,7 +992,7 @@
                                      [stop-scripts (cons script-proc (facet-stop-scripts f))])))))
 
 (define (make-empty-pending-scripts)
-  (make-vector priority-count '()))
+  (make-vector priority-count (make-queue)))
 
 (define (boot-actor script-proc)
   (with-store [(current-actor-state
@@ -1008,17 +1009,21 @@
       (schedule-script! #f script-proc)
       (run-scripts!))))
 
-(define (scripts-pending?)
-  (for/or [(scripts (in-vector (current-pending-scripts)))]
-    (not (null? scripts))))
+(define (pop-next-script!)
+  (define priority-levels (current-pending-scripts))
+  (let loop ((level 0))
+    (and (< level (vector-length priority-levels))
+         (let ((q (vector-ref priority-levels level)))
+           (if (queue-empty? q)
+               (loop (+ level 1))
+               (let-values (((script q) (dequeue q)))
+                 (vector-set! priority-levels level q)
+                 script))))))
 
 (define (run-all-pending-scripts!)
-  (when (scripts-pending?)
-    (define pending-scripts (current-pending-scripts))
-    (current-pending-scripts (make-empty-pending-scripts))
-    (for* [(scripts (in-vector pending-scripts))
-           (script (in-list (reverse scripts)))]
-      (script))
+  (define script (pop-next-script!))
+  (when script
+    (script)
     (refresh-facet-assertions!)
     (run-all-pending-scripts!)))