This commit is contained in:
Tony Garnock-Jones 2021-05-31 12:25:44 +02:00
parent bcbc660ff1
commit e5b87f5bb0
1 changed files with 17 additions and 23 deletions

View File

@ -194,27 +194,21 @@
(define parent (facet-parent f))
(when parent (hash-remove! (facet-children parent) f))
(turn-call-with-facet turn f
(lambda (turn)
(for [(c (in-hash-keys (facet-children f)))]
(facet-terminate! turn c orderly?))
(when orderly?
(for [(h (in-list (reverse (facet-shutdown-actions f))))] (h turn)))
(for [(a (in-hash-values (facet-outbound f)))]
(turn-retract!* turn a))
(when orderly?
(queue-task!
(actor-engine (facet-actor f))
(lambda ()
(if parent
(when (facet-inert? parent)
(turn! parent
(lambda (turn)
(facet-terminate! turn parent #t))))
(turn! (actor-root (facet-actor f))
(lambda (turn)
(actor-terminate! turn (facet-actor f) #t))
#t)))))))))
(with-active-facet turn f
(lambda (turn)
(for [(c (in-hash-keys (facet-children f)))] (facet-terminate! turn c orderly?))
(when orderly? (for [(h (in-list (reverse (facet-shutdown-actions f))))] (h turn)))
(for [(a (in-hash-values (facet-outbound f)))] (turn-retract!* turn a))
(when orderly?
(queue-task!
(actor-engine (facet-actor f))
(lambda ()
(if parent
(when (facet-inert? parent)
(turn! parent (lambda (turn) (facet-terminate! turn parent #t))))
(turn! (actor-root (facet-actor f))
(lambda (turn) (actor-terminate! turn (facet-actor f) #t))
#t)))))))))
;;---------------------------------------------------------------------------
@ -233,7 +227,7 @@
(for [(a (in-list (reverse qq)))] (a turn)))))))
(set-turn-queues! turn #f)))))
(define (turn-call-with-facet outer-turn f action)
(define (with-active-facet outer-turn f action)
(let ((inner-turn (turn (generate-turn-id) f (turn-queues outer-turn))))
(action inner-turn)
(set-turn-queues! inner-turn #f)))
@ -248,7 +242,7 @@
(define (turn-facet! turn boot-proc)
(let ((new-facet (make-facet (facet-actor (turn-active-facet turn)) (turn-active-facet turn))))
(turn-call-with-facet turn new-facet (stop-if-inert-after boot-proc))
(with-active-facet turn new-facet (stop-if-inert-after boot-proc))
new-facet))
(define (turn-stop! turn [f (turn-active-facet turn)] [continuation void])