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

Handle additional cases: children present, and obsolescent parent. Additional fix for #18

This commit is contained in:
Tony Garnock-Jones 2017-07-12 11:38:08 -04:00
parent f6c145b4a7
commit 8a2ace112b
2 changed files with 42 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
racket/syndicate/actor.rkt
View File

@ -886,6 +886,12 @@
(define (lookup-facet fid)
(hash-ref (actor-state-facets (current-actor-state)) fid #f))
(define (facet-live-but-inert? fid)
(define f (lookup-facet fid))
(and f
(hash-empty? (facet-endpoints f))
(set-empty? (facet-children f))))
(define (update-facet! fid proc)
(define old-facet (lookup-facet fid))
(define new-facet (proc old-facet))
@ -987,28 +993,33 @@
(lambda (pf)
(and pf (struct-copy facet pf
[children (set-add (facet-children pf) fid)]))))
(with-current-facet fid #f (setup-proc))
(with-current-facet fid #f
(setup-proc)
(schedule-script!
(lambda ()
(when (and (facet-live? fid)
(or (and (pair? parent-fid) (not (facet-live? parent-fid)))
(facet-live-but-inert? fid)))
(terminate-facet! fid)))))
(facet-handle-event! fid
(lookup-facet fid)
(patch (actor-state-knowledge (current-actor-state)) trie-empty)
#t)
(when (and (facet-live? fid)
(or (and (pair? parent-fid) (not (facet-live? parent-fid)))
(hash-empty? (facet-endpoints (lookup-facet fid)))))
(terminate-facet! fid)))
#t))
;; If the named facet is live, terminate it.
(define (terminate-facet! fid)
(define f (lookup-facet fid))
(when f
(let ((parent-fid (cdr fid)))
(when (pair? parent-fid)
(update-facet! parent-fid
(lambda (f)
(and f
(struct-copy facet f
[children (set-remove (facet-children f)
fid)]))))))
(define parent-fid (cdr fid))
(when (pair? parent-fid)
(update-facet! parent-fid
(lambda (f)
(and f
(struct-copy facet f
[children (set-remove (facet-children f)
fid)])))))
(store-facet! fid #f)
(for [(child-fid (in-set (facet-children f)))]
@ -1027,7 +1038,10 @@
(define-values (new-mux _eid _delta delta-aggregate)
(mux-remove-stream (actor-state-mux a) eid))
(current-actor-state (struct-copy actor-state a [mux new-mux]))
(schedule-action! delta-aggregate))))))
(schedule-action! delta-aggregate))))
(when (facet-live-but-inert? parent-fid)
(terminate-facet! parent-fid))))
(define (add-stop-script! script-proc)
(update-facet! (current-facet-id)

13
racket/syndicate/examples/actor/vacuous-facet.rkt
View File

@ -9,3 +9,16 @@
;; This actor will have one facet briefly, before dropping to zero and terminating:
(spawn (on-start (printf "Hi 2!\n"))
(on-stop (printf "Bye 2!\n")))
;; This actor will spawn a couple of nested facets, and when the inner
;; one terminates, the outer one will also be terminated:
(spawn (on-start
(printf "3 outer\n")
(react (on-start (printf "3 inner\n")
(send! 'terminate-three))
(on (message 'terminate-three)
(printf "triggering 3 inner stop\n")
(stop-current-facet))
(on-stop (printf "3 inner stop\n"))))
(on-stop
(printf "3 outer stop\n")))