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

Widen ground-level inertness detection to account for non-event ground-level gestalt.

This commit is contained in:
Tony Garnock-Jones 2014-06-12 20:26:14 -04:00
parent 30c007e0be
commit 5b7b192b60
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
minimart/ground.rkt
View File

@ -64,29 +64,33 @@
(define (run-ground . boot-actions)
(parameterize ((current-ground-event-async-channel (make-async-channel)))
(let await-interrupt ((inert? #f) (p (spawn-world boot-actions)) (active-events '()))
(define event-list (cons (current-ground-event-async-channel)
(if inert?
active-events
(cons idle-handler active-events))))
(if (null? event-list)
(define active-gestalt (process-gestalt p))
(define event-list (if inert?
active-events
(cons idle-handler active-events)))
(if (and (null? event-list) (gestalt-empty? active-gestalt))
(begin (log-info "run-ground: Terminating because inert")
(void))
(let ((e (apply sync event-list)))
(let ((e (apply sync (current-ground-event-async-channel) event-list)))
(match (deliver-event e -2 p)
[#f ;; inert
(await-interrupt #t p active-events)]
[(transition new-state actions)
(let process-actions ((actions (flatten actions)) (active-events active-events))
(let process-actions ((actions (flatten actions)) (g active-gestalt))
(match actions
['()
(await-interrupt #f (struct-copy process p [state new-state]) active-events)]
(await-interrupt #f
(struct-copy process p
[gestalt g]
[state new-state])
(extract-active-events g))]
[(cons a actions)
(match a
[(routing-update gestalt)
(process-actions actions (extract-active-events gestalt))]
(process-actions actions gestalt)]
[(quit)
(log-info "run-ground: Terminating by request")
(void)]
[_
(log-warning "run-ground: ignoring useless meta-action ~v" a)
(process-actions actions active-events)])]))]))))))
(process-actions actions g)])]))]))))))