2014-08-06 19:16:50 +00:00
|
|
|
#lang racket/base
|
2013-03-29 03:00:29 +00:00
|
|
|
|
|
|
|
(require racket/match)
|
2014-08-06 19:16:50 +00:00
|
|
|
(require "structs.rkt")
|
2013-03-29 03:00:29 +00:00
|
|
|
(require "roles.rkt")
|
|
|
|
(require "vm.rkt")
|
|
|
|
(require "process.rkt")
|
2014-08-06 19:16:50 +00:00
|
|
|
(require "quasiqueue.rkt")
|
2013-03-29 03:00:29 +00:00
|
|
|
|
|
|
|
(provide do-delete-endpoint
|
|
|
|
delete-all-endpoints)
|
|
|
|
|
2014-08-06 19:16:50 +00:00
|
|
|
;; do-delete-endpoint : (All (State) PreEID Reason (process State) vm
|
|
|
|
;; -> (values (process State) vm))
|
2013-03-29 03:00:29 +00:00
|
|
|
(define (do-delete-endpoint pre-eid reason p state)
|
|
|
|
(cond
|
|
|
|
[(hash-has-key? (process-endpoints p) pre-eid)
|
|
|
|
(define old-endpoint (hash-ref (process-endpoints p) pre-eid))
|
|
|
|
(let-values (((p state) (notify-route-change-vm (remove-endpoint p old-endpoint)
|
|
|
|
old-endpoint
|
2014-08-06 19:16:50 +00:00
|
|
|
(lambda (t) (absence-event t reason))
|
2013-03-29 03:00:29 +00:00
|
|
|
state)))
|
|
|
|
(values p state))]
|
|
|
|
[else
|
|
|
|
(values p state)]))
|
|
|
|
|
2014-08-06 19:16:50 +00:00
|
|
|
;; remove-endpoint : (All (State) (process State) (endpoint State) -> (process State))
|
2013-03-29 03:00:29 +00:00
|
|
|
(define (remove-endpoint p ep)
|
|
|
|
(define pre-eid (eid-pre-eid (endpoint-id ep)))
|
|
|
|
(struct-copy process p [endpoints (hash-remove (process-endpoints p) pre-eid)]))
|
|
|
|
|
2014-08-06 19:16:50 +00:00
|
|
|
;; delete-all-endpoints : (All (State) Reason (process State) vm
|
|
|
|
;; -> (values (process State) vm (QuasiQueue (Action vm))))
|
2013-03-29 03:00:29 +00:00
|
|
|
(define (delete-all-endpoints reason p state)
|
|
|
|
(let-values (((p state)
|
2014-08-06 19:16:50 +00:00
|
|
|
(for/fold ([p p] [state state])
|
2013-03-29 03:00:29 +00:00
|
|
|
([pre-eid (in-hash-keys (process-endpoints p))])
|
|
|
|
(do-delete-endpoint pre-eid reason p state))))
|
|
|
|
(values p
|
|
|
|
state
|
|
|
|
(list->quasiqueue
|
2014-08-06 19:16:50 +00:00
|
|
|
(map (lambda (pre-eid)
|
|
|
|
(delete-endpoint (eid (process-pid p) pre-eid) reason))
|
2013-03-29 03:00:29 +00:00
|
|
|
(hash-keys (process-meta-endpoints p)))))))
|