Inform both parent and child of spawned pid
This commit is contained in:
parent
97abcf91d2
commit
8f2b4834fc
|
@ -26,7 +26,7 @@
|
||||||
(transition 'no-state (kill)))))))
|
(transition 'no-state (kill)))))))
|
||||||
|
|
||||||
(define spy
|
(define spy
|
||||||
(lambda ()
|
(lambda (spy-pid)
|
||||||
(define (hs label)
|
(define (hs label)
|
||||||
(define ((w kind) . args) (write `(,label ,kind ,@args)) (newline) values)
|
(define ((w kind) . args) (write `(,label ,kind ,@args)) (newline) values)
|
||||||
(handlers (w 'presence)
|
(handlers (w 'presence)
|
||||||
|
@ -36,9 +36,9 @@
|
||||||
(add-role (topic-publisher (wild) #:virtual? #t) (hs 'subscriber->publisher))
|
(add-role (topic-publisher (wild) #:virtual? #t) (hs 'subscriber->publisher))
|
||||||
(add-role (topic-subscriber (wild) #:virtual? #t) (hs 'publisher->subscriber)))))
|
(add-role (topic-subscriber (wild) #:virtual? #t) (hs 'publisher->subscriber)))))
|
||||||
|
|
||||||
(ground-vm (lambda ()
|
(ground-vm (lambda (boot-pid)
|
||||||
(transition 'no-state
|
(transition 'no-state
|
||||||
(spawn spy)
|
(spawn spy)
|
||||||
(spawn (lambda () (example-process 1000)))
|
(spawn (lambda (pid) (example-process 1000)))
|
||||||
(spawn (lambda () (example-process 2000)))
|
(spawn (lambda (pid) (example-process 2000)))
|
||||||
(kill))))
|
(kill))))
|
||||||
|
|
18
os2.rkt
18
os2.rkt
|
@ -101,7 +101,7 @@
|
||||||
(struct add-role (topics handlers k) #:prefab)
|
(struct add-role (topics handlers k) #:prefab)
|
||||||
(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 (main k) #:prefab)
|
||||||
(struct kill (pid reason) #: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).
|
||||||
|
@ -151,7 +151,7 @@
|
||||||
(define (make-transition state . actions) (transition state actions))
|
(define (make-transition state . actions) (transition state actions))
|
||||||
(define (make-add-role topics handlers [k #f]) (add-role topics handlers k))
|
(define (make-add-role topics handlers [k #f]) (add-role topics handlers k))
|
||||||
(define (make-delete-role eid [reason #f]) (delete-role eid reason))
|
(define (make-delete-role eid [reason #f]) (delete-role eid reason))
|
||||||
(define (make-spawn thunk [k #f]) (spawn thunk k))
|
(define (make-spawn main [k #f]) (spawn main k))
|
||||||
(define (make-kill [pid #f] [reason #f]) (kill pid reason))
|
(define (make-kill [pid #f] [reason #f]) (kill pid reason))
|
||||||
|
|
||||||
(define (extend-transition t . more-actions)
|
(define (extend-transition t . more-actions)
|
||||||
|
@ -250,7 +250,7 @@
|
||||||
[(add-role topics hs k) (do-subscribe pid (ensure-topic-union topics) hs k state)]
|
[(add-role topics hs k) (do-subscribe pid (ensure-topic-union topics) 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 main k) (do-spawn pid main k state)]
|
||||||
[(kill pid-to-kill reason) (do-kill (or pid-to-kill pid) reason state)]))
|
[(kill pid-to-kill reason) (do-kill (or pid-to-kill pid) reason state)]))
|
||||||
|
|
||||||
(define (do-subscribe pid topics hs k state)
|
(define (do-subscribe pid topics hs k state)
|
||||||
|
@ -348,12 +348,12 @@
|
||||||
message-topic
|
message-topic
|
||||||
body)))
|
body)))
|
||||||
|
|
||||||
(define (do-spawn spawning-pid thunk k state)
|
(define (do-spawn spawning-pid main k state)
|
||||||
|
(define new-pid (vm-next-process-id state))
|
||||||
(match-define (transition initial-state initial-actions)
|
(match-define (transition initial-state initial-actions)
|
||||||
(cond
|
(cond
|
||||||
[(procedure? thunk) (send-to-user (lambda (e) (transition #f (kill #f e))) thunk)]
|
[(procedure? main) (send-to-user (lambda (e) (transition #f (kill #f e))) main new-pid)]
|
||||||
[(transition? thunk) thunk]))
|
[(transition? main) main]))
|
||||||
(define new-pid (vm-next-process-id state))
|
|
||||||
(define spawned-state
|
(define spawned-state
|
||||||
(struct-copy vm (enqueue-actions state new-pid initial-actions)
|
(struct-copy vm (enqueue-actions state new-pid initial-actions)
|
||||||
[processes (hash-set (vm-processes state)
|
[processes (hash-set (vm-processes state)
|
||||||
|
@ -414,8 +414,8 @@
|
||||||
(wrap-trapk pid k))]
|
(wrap-trapk pid k))]
|
||||||
[(? delete-role?) preaction]
|
[(? delete-role?) preaction]
|
||||||
[(? send-message?) preaction]
|
[(? send-message?) preaction]
|
||||||
[(spawn thunk k)
|
[(spawn main k)
|
||||||
(spawn thunk (wrap-trapk pid k))]
|
(spawn main (wrap-trapk pid k))]
|
||||||
[(? kill?) preaction]))
|
[(? kill?) preaction]))
|
||||||
|
|
||||||
(define (nested-vm boot)
|
(define (nested-vm boot)
|
||||||
|
|
Loading…
Reference in New Issue