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

"Linking" during spawn; and during/spawn

This commit is contained in:
Tony Garnock-Jones 2021-06-09 23:06:40 +02:00
parent 5dec0afe39
commit b12fc5188d
2 changed files with 44 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
syndicate/actor.rkt
View File

@ -171,11 +171,11 @@
'()))
(when (not daemon?)
(adjust-inhabitant-count! engine +1))
(set-actor-root! ac (make-facet ac #f initial-assertions))
(set-actor-root! ac (make-facet ac #f))
(log-syndicate/actor-info "~a booting" ac)
(turn! (make-facet ac (actor-root ac))
(stop-if-inert-after boot-proc))
ac)
(define user-root-facet (make-facet ac (actor-root ac) initial-assertions))
(turn! user-root-facet (stop-if-inert-after boot-proc))
user-root-facet)
(define (actor-add-exit-hook! ac hook)
(set-actor-exit-hooks! ac (cons hook (actor-exit-hooks ac))))
@ -331,7 +331,9 @@
(define (turn-spawn! turn boot-proc [initial-assertions (make-hash)]
#:name [name '?]
#:daemon? [daemon? #f])
#:daemon? [daemon? #f]
#:link [link-entity #f]
#:link-message [link-message 'alive])
(define f (turn-active-facet turn))
(define o (facet-outbound f))
(log-syndicate/actor-debug " ENQ spawn ~a" name)
@ -344,9 +346,19 @@
(hash-set! new-outbound handle (hash-ref o handle))
(hash-remove! o handle))
(define engine (actor-engine (facet-actor f)))
(queue-task! engine
(lambda ()
(make-actor name engine daemon? boot-proc new-outbound))))))
(define new-actor-facet (make-actor name engine daemon? boot-proc new-outbound))
(when link-entity
(define handle (generate-handle))
(define linked-peer (entity-ref new-actor-facet link-entity '()))
(define a (outbound-assertion handle linked-peer #t))
(hash-set! o handle a)
(log-syndicate/actor-debug " ENQ link at ~v assert ~v handle ~v"
linked-peer link-message handle)
(turn! new-actor-facet
(lambda (turn)
(log-syndicate/actor-debug " DELIVER link to ~v assert ~v handle ~v"
linked-peer link-message handle)
(deliver (entity-assert link-entity) turn link-message handle)))))))
(define (turn-stop-actor! turn)
(define ac (facet-actor (turn-active-facet turn)))

24
syndicate/syntax.rkt
View File

@ -34,6 +34,7 @@
stop-when
(rename-out [event:when when])
during
during/spawn
during*)
(require racket/match)
@ -204,6 +205,29 @@
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
expr ...)))))])))
(define-event-expander during/spawn
(lambda (stx)
(syntax-parse stx
[(_ pat name-stx:<name> daemon:<daemon?> expr ...)
#`(assert
(Observe (:pattern pat)
(ref (during*
(action (bindings)
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
(define name name-stx.N)
(define monitor
(ref (entity #:name (list name 'monitor-in-parent)
#:retract (action (_handle) (stop-current-facet)))))
(define monitor-handle (turn-assert! this-turn monitor 'alive))
(turn-spawn! this-turn
#:name name
#:daemon? daemon.D
#:link
(entity #:name (list name 'monitor-in-child)
#:retract (action (_handle) (stop-current-facet)))
(action () expr ...)
(hasheq monitor-handle #t)))))))])))
(define (during* f #:name [name '?])
(define assertion-map (make-hash))
(entity #:name name