This commit is contained in:
Tony Garnock-Jones 2012-03-24 21:18:19 -04:00
parent e18b1f2a8c
commit 4246e5b217
1 changed files with 25 additions and 23 deletions

48
os2.rkt
View File

@ -340,6 +340,31 @@
message-topic
body)))
(define (do-spawn spawning-pid thunk k state)
(match-define (transition initial-state initial-actions)
(cond
[(procedure? thunk) (send-to-user (lambda (e) (transition #f (kill #f e))) thunk)]
[(transition? thunk) thunk]))
(define new-pid (vm-next-process-id state))
(define spawned-state
(struct-copy vm (enqueue-actions state new-pid initial-actions)
[processes (hash-set (vm-processes state)
new-pid
(process new-pid initial-state 0 (set)))]
[next-process-id (+ new-pid 1)]))
(run-trapk spawned-state spawning-pid k new-pid))
(define (do-kill pid-to-kill reason state)
(cond
[(hash-has-key? (vm-processes state) pid-to-kill)
(let ((state (for/fold ([state state])
([eid (in-set (process-endpoints
(hash-ref (vm-processes state) pid-to-kill)))])
(do-unsubscribe pid-to-kill eid reason state))))
(struct-copy vm state
[processes (hash-remove (vm-processes state) pid-to-kill)]))]
[else state]))
(define (run-trapk state pid trap-k . args)
(if trap-k
(let ((failure-proc (lambda (e) (lambda (process-state)
@ -363,29 +388,6 @@
(struct-copy process old-process
[state new-state]))]))
(define (do-spawn spawning-pid thunk k state)
(match-define (transition initial-state initial-actions)
(send-to-user (lambda (e) (transition #f (kill #f e))) thunk))
(define new-pid (vm-next-process-id state))
(define spawned-state
(struct-copy vm (enqueue-actions state new-pid initial-actions)
[processes (hash-set (vm-processes state)
new-pid
(process new-pid initial-state 0 (set)))]
[next-process-id (+ new-pid 1)]))
(run-trapk spawned-state spawning-pid k new-pid))
(define (do-kill pid-to-kill reason state)
(cond
[(hash-has-key? (vm-processes state) pid-to-kill)
(let ((state (for/fold ([state state])
([eid (in-set (process-endpoints
(hash-ref (vm-processes state) pid-to-kill)))])
(do-unsubscribe pid-to-kill eid reason state))))
(struct-copy vm state
[processes (hash-remove (vm-processes state) pid-to-kill)]))]
[else state]))
(define (enqueue-actions state pid actions)
(struct-copy vm state
[pending-actions (append (reverse (for/list ([a (flatten actions)]) (cons pid a)))