Act on outbound ground metamessages before checking for inertness.

This commit is contained in:
Tony Garnock-Jones 2012-01-11 16:05:53 -05:00
parent 85709e4a0d
commit 591082fa01
1 changed files with 2 additions and 2 deletions

4
os.rkt
View File

@ -292,16 +292,16 @@
;; Runs its argument VM until it becomes (provably) inert. ;; Runs its argument VM until it becomes (provably) inert.
(define (ground-vm pattern-predicate boot) (define (ground-vm pattern-predicate boot)
(let loop ((transition (run-vm (make-vm pattern-predicate boot)))) (let loop ((transition (run-vm (make-vm pattern-predicate boot))))
(for-each (lambda (thunk) (thunk)) (kernel-mode-transition-messages transition))
(when (not (nested-vm-inert? (kernel-mode-transition-subscription transition))) (when (not (nested-vm-inert? (kernel-mode-transition-subscription transition)))
(match transition (match transition
[(kernel-mode-transition (subscription new-state [(kernel-mode-transition (subscription new-state
polling-k polling-k
message-handlers message-handlers
'()) '())
outbound-messages _
'() '()
'()) '())
(for-each (lambda (thunk) (thunk)) outbound-messages)
(define inbound-messages (define inbound-messages
(map (match-lambda [(message-handler e k) (wrap-evt e (lambda (v) (cons v k)))]) (map (match-lambda [(message-handler e k) (wrap-evt e (lambda (v) (cons v k)))])
message-handlers)) message-handlers))