From 8154ecbc0e40a23b0965cbfc3095d54deeafbe5b Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 24 Mar 2012 15:58:45 -0400 Subject: [PATCH] Add kill action --- os2.rkt | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/os2.rkt b/os2.rkt index b295e75..6ca234f 100644 --- a/os2.rkt +++ b/os2.rkt @@ -64,6 +64,7 @@ (struct delete-role (eid reason) #:prefab) (struct send-message (topic body) #:prefab) (struct spawn (thunk k) #:prefab) +(struct kill (pid reason) #:prefab) ;; An Action is either a Preaction or an (at-meta-level Preaction). (struct at-meta-level (preaction) #:prefab) @@ -151,7 +152,8 @@ [(add-role topic hs k) (do-subscribe pid topic hs k state)] [(delete-role eid reason) (do-unsubscribe pid eid reason state)] [(send-message topic body) (route-and-deliver topic body state)] - [(spawn thunk k) (do-spawn pid thunk k state)])) + [(spawn thunk k) (do-spawn pid thunk k state)] + [(kill pid-to-kill reason) (do-kill (or pid-to-kill pid) reason state)])) (define (do-subscribe pid topic hs k state) (define old-process (hash-ref (vm-processes state) pid)) @@ -260,6 +262,17 @@ 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 (quasi-enqueue-many (for/list ([a (flatten actions)]) (cons pid a)) @@ -281,7 +294,8 @@ [(? delete-role?) preaction] [(? send-message?) preaction] [(spawn thunk k) - (spawn thunk (wrap-trapk pid k))])) + (spawn thunk (wrap-trapk pid k))] + [(? kill?) preaction])) ;;---------------------------------------------------------------------------