From 4246e5b2177ed28c54650dec972f244d9abc36a0 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 24 Mar 2012 21:18:19 -0400 Subject: [PATCH] Cosmetic --- os2.rkt | 48 +++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/os2.rkt b/os2.rkt index 2b1d342..ed518ba 100644 --- a/os2.rkt +++ b/os2.rkt @@ -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)))