syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Leave a "tombstone" so we can see the process's name while any record of it remains.

This commit is contained in:
Tony Garnock-Jones 2016-07-31 11:36:25 -04:00
parent 15b5406932
commit f34924bc6d
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
racket/syndicate/dataspace.rkt
View File

@ -60,13 +60,14 @@
(trace-process-step-result e pid behavior old-state exn #f) (trace-process-step-result e pid behavior old-state exn #f)
(enqueue-actions (disable-process pid exn w) pid (list 'quit))))))) (enqueue-actions (disable-process pid exn w) pid (list 'quit)))))))
(define (update-state w pid s) (define (update-process-entry w pid f)
(define old-pt (dataspace-process-table w)) (define old-pt (dataspace-process-table w))
(define old-p (hash-ref old-pt pid #f)) (match (hash-ref old-pt pid #f)
(if old-p [#f w]
(struct-copy dataspace w [old-p (struct-copy dataspace w [process-table (hash-set old-pt pid (f old-p))])]))
[process-table (hash-set old-pt pid (update-process-state old-p s))])
w)) (define (update-state w pid s)
(update-process-entry w pid (lambda (p) (update-process-state p s))))
(define (send-event/guard e pid w) (define (send-event/guard e pid w)
(if (patch-empty? e) (if (patch-empty? e)
@ -79,8 +80,8 @@
(process-name (hash-ref (dataspace-process-table w) pid missing-process)) (process-name (hash-ref (dataspace-process-table w) pid missing-process))
(append (current-actor-path) (list pid)) (append (current-actor-path) (list pid))
(exn->string exn))) (exn->string exn)))
(struct-copy dataspace w ;; We leave a "tombstone", just the process name, until the 'quit pseudoaction takes effect.
[process-table (hash-remove (dataspace-process-table w) pid)])) (update-process-entry w pid (lambda (p) (process (process-name p) #f #f))))
(define (invoke-process pid thunk k-ok k-exn) (define (invoke-process pid thunk k-ok k-exn)
(define-values (ok? result) (define-values (ok? result)
@ -171,8 +172,10 @@
['quit ['quit
(define-values (new-mux _label delta delta-aggregate) (define-values (new-mux _label delta delta-aggregate)
(mux-remove-stream (dataspace-mux w) label)) (mux-remove-stream (dataspace-mux w) label))
;; behavior & state in w already removed by disable-process ;; Clean up the "tombstone" left for us by disable-process
(deliver-patches w new-mux label delta delta-aggregate)] (let ((w (struct-copy dataspace w
[process-table (hash-remove (dataspace-process-table w) label)])))
(deliver-patches w new-mux label delta delta-aggregate))]
[(quit-dataspace) [(quit-dataspace)
(quit)] (quit)]
[(? patch? delta-orig) [(? patch? delta-orig)