Add kill action

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]))
 
 ;;---------------------------------------------------------------------------