syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

run-actor -> run-ground, and detect system inertness.

This commit is contained in:
Tony Garnock-Jones 2013-10-28 10:17:59 +00:00
parent 6d025ef69d
commit 63efb81656
1 changed files with 26 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
ground.rkt
View File

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