From 63efb8165665e51e3f3c269d67ead3b17796cf57 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Mon, 28 Oct 2013 10:17:59 +0000
Subject: [PATCH] run-actor -> run-ground, and detect system inertness.

---
 ground.rkt | 49 ++++++++++++++++++++++++++-----------------------
 1 file changed, 26 insertions(+), 23 deletions(-)

diff --git a/ground.rkt b/ground.rkt
index 52c48ee..97d3136 100644
--- a/ground.rkt
+++ b/ground.rkt
@@ -5,7 +5,7 @@
 (require "core.rkt")
 
 (provide (struct-out event)
-	 run-actor)
+	 run-ground)
 
 (struct event (descriptor values) #:prefab)
 
@@ -25,28 +25,31 @@
 (define idle-handler
   (handle-evt (system-idle-evt) (lambda _ #f)))
 
-(define (run-actor p)
-  (let await-interrupt ((inert? #f) (p p) (active-events '()))
+(define (run-ground . boot-actions)
+  (let await-interrupt ((inert? #f) (p (spawn-world boot-actions)) (active-events '()))
     (define event-list (if inert?
 			   active-events
 			   (cons idle-handler active-events)))
-    (define e (apply sync event-list))
-    (log-info "Woke: ~v" e)
-    (match (deliver-event e -1 p)
-      [#f ;; inert
-       (await-interrupt #t p active-events)]
-      [(transition new-state actions)
-       (let process-actions ((actions (flatten actions)) (active-events active-events))
-	 (match actions
-	   ['()
-	    (await-interrupt #f (struct-copy process p [state new-state]) active-events)]
-	   [(cons a actions)
-	    (match a
-	      [(routing-update routes)
-	       (process-actions actions (extract-active-events routes))]
-	      [(quit)
-	       (log-info "run-actor: Exiting by request")
-	       (void)]
-	      [_
-	       (log-warning "run-actor: ignoring useless meta-action ~v" a)
-	       (process-actions actions active-events)])]))])))
+    (if (null? event-list)
+	(begin (log-info "run-ground: Terminating because inert")
+	       (void))
+	(let ((e (apply sync event-list)))
+	  (log-info "Woke: ~v" e)
+	  (match (deliver-event e -1 p)
+	    [#f ;; inert
+	     (await-interrupt #t p active-events)]
+	    [(transition new-state actions)
+	     (let process-actions ((actions (flatten actions)) (active-events active-events))
+	       (match actions
+		 ['()
+		  (await-interrupt #f (struct-copy process p [state new-state]) active-events)]
+		 [(cons a actions)
+		  (match a
+		    [(routing-update routes)
+		     (process-actions actions (extract-active-events routes))]
+		    [(quit)
+		     (log-info "run-ground: Terminating by request")
+		     (void)]
+		    [_
+		     (log-warning "run-ground: ignoring useless meta-action ~v" a)
+		     (process-actions actions active-events)])]))])))))