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)])]))])))))