Redo actor-group linking style

This commit is contained in:
Tony Garnock-Jones 2021-06-15 12:43:27 +02:00
parent 0b1e9874d1
commit 210e983c8d
3 changed files with 17 additions and 11 deletions

View File

@ -178,16 +178,17 @@
(adjust-inhabitant-count! e -1)))
(actor-system-wait e))
(define (make-actor-group outer-boot-proc inner-boot-proc #:name [name 'actor-group])
(define f (turn-facet! (lambda ()
(facet-prevent-inert-check! (turn-active-facet (current-turn)))
(outer-boot-proc))))
(define (make-actor-group boot-proc
#:name [name 'actor-group]
#:link? [link? #f])
(define owning-facet (turn-active-facet (current-turn)))
(define e (make-engine 1 name (lambda (restart)
(turn! f (lambda () (turn-stop!)))
(when link? (turn! owning-facet (lambda () (turn-stop!))))
(actor-system-shutdown! e)
(restart void))))
(when link? (facet-on-stop! owning-facet (lambda () (actor-system-shutdown! e))))
(queue-task! e (lambda ()
(make-actor name e #t inner-boot-proc (make-hash))
(make-actor name e #t boot-proc (make-hash))
(adjust-inhabitant-count! e -1)))
e)

View File

@ -4,7 +4,8 @@
(provide (for-syntax <when>
<name>
<daemon?>))
<daemon?>
<link?>))
(require (for-syntax racket/base))
(require (for-syntax syntax/parse))
@ -20,4 +21,8 @@
(define-splicing-syntax-class <daemon?>
(pattern (~seq #:daemon? D))
(pattern (~seq) #:attr D #'#f)))
(pattern (~seq) #:attr D #'#f))
(define-splicing-syntax-class <link?>
(pattern (~seq #:link? L))
(pattern (~seq) #:attr L #'#f)))

View File

@ -82,9 +82,9 @@
(define-syntax (actor-group stx)
(syntax-parse stx
[(_ name:<name> [outer-facet-expr ...] group-boot-expr ...)
[(_ name:<name> link:<link?> group-boot-expr ...)
#'(make-actor-group #:name name.N
(lambda () outer-facet-expr ...)
#:link? link.L
(lambda () group-boot-expr ...))]))
(define-syntax (object stx)
@ -362,7 +362,7 @@
;;---------------------------------------------------------------------------
;;; Local Variables:
;;; eval: (put 'actor-group 'racket-indent-function 1)
;;; eval: (put 'actor-group 'racket-indent-function 0)
;;; eval: (put 'actor-system/dataspace 'racket-indent-function 1)
;;; eval: (put 'at 'racket-indent-function 1)
;;; eval: (put 'object 'racket-indent-function 0)