syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix monitoring: I had neglected to use the wrapped main spec!

This commit is contained in:
Tony Garnock-Jones 2012-07-03 13:12:31 -04:00
parent 1ffd0afe66
commit e67bffdcc3
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
os2.rkt
View File

@ -238,24 +238,30 @@
(define (make-send-message body [role 'publisher]) (send-message body role))
(define (make-kill [pid #f] #:reason [reason #f]) (kill pid reason))
(define (make-spawn main [k #f]
(define (make-spawn raw-spec [k #f]
#:monitor? [monitor? #f]
#:debug-name [debug-name #f]
#:state-contract [state-contract any/c])
(match-define (boot-specification raw-main raw-contract)
(cond [(boot-specification? raw-spec) raw-spec]
[else (boot-specification raw-spec any/c)]))
(define maybe-monitored-main
(if monitor?
(let ((unmonitored-main (if (procedure? main) main (lambda (self-pid) main))))
(let ((unmonitored-main (if (procedure? raw-main) raw-main (lambda (self-pid) raw-main))))
(lambda (self-pid)
(define m (monitor self-pid debug-name))
(prefix-transition (unmonitored-main self-pid)
(role (list 'canary m) (topic-publisher m) #:state state))))
main))
raw-main))
(define final-contract
(cond [(eq? raw-contract any/c) state-contract]
[(eq? state-contract any/c) raw-contract]
[else (error 'spawn
"Cannot apply #:state-contract to already-contracted boot-specification")]))
(define spec
(if (eq? state-contract any/c)
main
(if (boot-specification? main)
(error 'spawn "Cannot apply #:state-contract to already-contracted boot-specification")
(boot-specification main state-contract))))
(if (eq? final-contract any/c)
maybe-monitored-main
(boot-specification maybe-monitored-main final-contract)))
(spawn spec k debug-name))
(define (extend-transition t . more-actions)