Add kill action
This commit is contained in:
parent
44898b09b2
commit
8154ecbc0e
18
os2.rkt
18
os2.rkt
|
@ -64,6 +64,7 @@
|
||||||
(struct delete-role (eid reason) #:prefab)
|
(struct delete-role (eid reason) #:prefab)
|
||||||
(struct send-message (topic body) #:prefab)
|
(struct send-message (topic body) #:prefab)
|
||||||
(struct spawn (thunk k) #:prefab)
|
(struct spawn (thunk k) #:prefab)
|
||||||
|
(struct kill (pid reason) #:prefab)
|
||||||
|
|
||||||
;; An Action is either a Preaction or an (at-meta-level Preaction).
|
;; An Action is either a Preaction or an (at-meta-level Preaction).
|
||||||
(struct at-meta-level (preaction) #:prefab)
|
(struct at-meta-level (preaction) #:prefab)
|
||||||
|
@ -151,7 +152,8 @@
|
||||||
[(add-role topic hs k) (do-subscribe pid topic hs k state)]
|
[(add-role topic hs k) (do-subscribe pid topic hs k state)]
|
||||||
[(delete-role eid reason) (do-unsubscribe pid eid reason state)]
|
[(delete-role eid reason) (do-unsubscribe pid eid reason state)]
|
||||||
[(send-message topic body) (route-and-deliver topic body 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 (do-subscribe pid topic hs k state)
|
||||||
(define old-process (hash-ref (vm-processes state) pid))
|
(define old-process (hash-ref (vm-processes state) pid))
|
||||||
|
@ -260,6 +262,17 @@
|
||||||
k
|
k
|
||||||
new-pid))
|
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)
|
(define (enqueue-actions state pid actions)
|
||||||
(struct-copy vm state
|
(struct-copy vm state
|
||||||
[pending-actions (quasi-enqueue-many (for/list ([a (flatten actions)]) (cons pid a))
|
[pending-actions (quasi-enqueue-many (for/list ([a (flatten actions)]) (cons pid a))
|
||||||
|
@ -281,7 +294,8 @@
|
||||||
[(? delete-role?) preaction]
|
[(? delete-role?) preaction]
|
||||||
[(? send-message?) preaction]
|
[(? send-message?) preaction]
|
||||||
[(spawn thunk k)
|
[(spawn thunk k)
|
||||||
(spawn thunk (wrap-trapk pid k))]))
|
(spawn thunk (wrap-trapk pid k))]
|
||||||
|
[(? kill?) preaction]))
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue