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

Safety: wrap spawn intermediate step in send-to-user to blame appropriate process

This commit is contained in:
Tony Garnock-Jones 2013-04-11 19:20:33 -04:00
parent 52750cf67f
commit cd7da75504
1 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
marketplace/action-spawn.rkt
View File

@ -27,17 +27,9 @@
(: co-quit : Reason -> CoTransition) (: co-quit : Reason -> CoTransition)
(define ((co-quit e) k) (define ((co-quit e) k)
((inst k False) (transition #f (quit #f e)))) ((inst k False) (transition #f (quit #f e))))
(: transition-accepter : (All (NewState) (Transition NewState) -> (: transition-accepter : (All (NewState) (Transition NewState) -> Process))
(List (process OldState) vm)))
(define (transition-accepter t) (define (transition-accepter t)
(match t (match-define (transition initial-state initial-actions) t)
[(transition initial-state initial-actions)
;;(matrix-log 'info "PID ~v (~a) started" new-pid debug-name)
(list (if parent-k
(run-ready p (send-to-user p (e) (quit-interruptk e)
(parent-k new-pid)))
p)
(inject-process (struct-copy vm state [next-process-id (+ new-pid 1)])
(mkProcess ((inst process NewState) (mkProcess ((inst process NewState)
debug-name debug-name
new-pid new-pid
@ -45,6 +37,13 @@
'() '()
#hash() #hash()
#hash() #hash()
(action-tree->quasiqueue initial-actions)))))])) (action-tree->quasiqueue initial-actions))))
(apply values ((inst new-cotransition (List (process OldState) vm)) (let ((new-process
transition-accepter))) (send-to-user* debug-name new-pid (e) (transition-accepter (transition #f (quit #f e)))
((inst new-cotransition Process) transition-accepter))))
(values (if parent-k
(run-ready p (send-to-user p (e) (quit-interruptk e)
(parent-k new-pid)))
p)
(inject-process (struct-copy vm state [next-process-id (+ new-pid 1)])
new-process))))