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

Introduce step-process (as composition of deliver-event and apply-transition)

This commit is contained in:
Tony Garnock-Jones 2014-06-21 07:29:21 -04:00
parent 3dc7d25724
commit b4e2e28027
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
minimart/core.rkt
View File

@ -276,6 +276,12 @@
(queue-empty? (world-process-actions w)) (queue-empty? (world-process-actions w))
(set-empty? (world-runnable-pids w)))) (set-empty? (world-runnable-pids w))))
;; Event PID Process World -> World
;; Delivers the event to the process, then applies the resulting
;; transition, updating the world.
(define (step-process e pid p w)
(apply-transition pid (deliver-event e pid p) w))
;; Event PID Process -> Transition ;; Event PID Process -> Transition
;; Delivers the event to the process, catching any exceptions it ;; Delivers the event to the process, catching any exceptions it
;; throws and converting them to quit Actions. ;; throws and converting them to quit Actions.
@ -451,8 +457,7 @@
[(message body meta-level feedback?) [(message body meta-level feedback?)
(define pids (gestalt-match-value (world-partial-gestalt w) body meta-level feedback?)) (define pids (gestalt-match-value (world-partial-gestalt w) body meta-level feedback?))
(define pt (world-process-table w)) (define pt (world-process-table w))
(for/fold ([w w]) [(pid (in-set pids))] (for/fold ([w w]) [(pid (in-set pids))] (step-process e pid (hash-ref pt pid) w))]
(apply-transition pid (deliver-event e pid (hash-ref pt pid)) w))]
[(pending-routing-update g affected-subgestalt known-target) [(pending-routing-update g affected-subgestalt known-target)
(define affected-pids (gestalt-match affected-subgestalt g)) (define affected-pids (gestalt-match affected-subgestalt g))
(define pt (world-process-table w)) (define pt (world-process-table w))
@ -460,8 +465,7 @@
[(pid (in-set (if known-target (set-add affected-pids known-target) affected-pids)))] [(pid (in-set (if known-target (set-add affected-pids known-target) affected-pids)))]
(match (hash-ref pt pid (lambda () #f)) (match (hash-ref pt pid (lambda () #f))
[#f w] [#f w]
[p (define g1 (gestalt-filter g (process-gestalt p))) [p (step-process (routing-update (gestalt-filter g (process-gestalt p))) pid p w)]))]))
(apply-transition pid (deliver-event (routing-update g1) pid p) w)]))]))
;; World -> Transition ;; World -> Transition
;; Polls the non-provably-inert processes identified by the ;; Polls the non-provably-inert processes identified by the
@ -478,7 +482,7 @@
(transition (for/fold ([w (struct-copy world w [runnable-pids (set)])]) (transition (for/fold ([w (struct-copy world w [runnable-pids (set)])])
[(pid (in-set runnable-pids))] [(pid (in-set runnable-pids))]
(define p (hash-ref (world-process-table w) pid (lambda () #f))) (define p (hash-ref (world-process-table w) pid (lambda () #f)))
(if (not p) w (apply-transition pid (deliver-event #f pid p) w))) (if (not p) w (step-process #f pid p w)))
'()))) ;; world needs another check to see if more can happen. '()))) ;; world needs another check to see if more can happen.
;; Behavior :> (Option Event) World -> Transition ;; Behavior :> (Option Event) World -> Transition