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

Inform both parent and child of spawned pid

This commit is contained in:
Tony Garnock-Jones 2012-04-12 14:47:05 -04:00
parent 97abcf91d2
commit 8f2b4834fc
2 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
os2-example.rkt
View File

@ -26,7 +26,7 @@
(transition 'no-state (kill)))))))
(define spy
(lambda ()
(lambda (spy-pid)
(define (hs label)
(define ((w kind) . args) (write `(,label ,kind ,@args)) (newline) values)
(handlers (w 'presence)
@ -36,9 +36,9 @@
(add-role (topic-publisher (wild) #:virtual? #t) (hs 'subscriber->publisher))
(add-role (topic-subscriber (wild) #:virtual? #t) (hs 'publisher->subscriber)))))
(ground-vm (lambda ()
(ground-vm (lambda (boot-pid)
(transition 'no-state
(spawn spy)
(spawn (lambda () (example-process 1000)))
(spawn (lambda () (example-process 2000)))
(spawn (lambda (pid) (example-process 1000)))
(spawn (lambda (pid) (example-process 2000)))
(kill))))

18
os2.rkt
View File

@ -101,7 +101,7 @@
(struct add-role (topics handlers k) #:prefab)
(struct delete-role (eid reason) #:prefab)
(struct send-message (topic body) #:prefab)
(struct spawn (thunk k) #:prefab)
(struct spawn (main k) #:prefab)
(struct kill (pid reason) #:prefab)
;; 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-add-role topics handlers [k #f]) (add-role topics handlers k))
(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 (extend-transition t . more-actions)
@ -250,7 +250,7 @@
[(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)]
[(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)]))
(define (do-subscribe pid topics hs k state)
@ -348,12 +348,12 @@
message-topic
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)
(cond
[(procedure? thunk) (send-to-user (lambda (e) (transition #f (kill #f e))) thunk)]
[(transition? thunk) thunk]))
(define new-pid (vm-next-process-id state))
[(procedure? main) (send-to-user (lambda (e) (transition #f (kill #f e))) main new-pid)]
[(transition? main) main]))
(define spawned-state
(struct-copy vm (enqueue-actions state new-pid initial-actions)
[processes (hash-set (vm-processes state)
@ -414,8 +414,8 @@
(wrap-trapk pid k))]
[(? delete-role?) preaction]
[(? send-message?) preaction]
[(spawn thunk k)
(spawn thunk (wrap-trapk pid k))]
[(spawn main k)
(spawn main (wrap-trapk pid k))]
[(? kill?) preaction]))
(define (nested-vm boot)