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

entity/stop-on-retract

This commit is contained in:
Tony Garnock-Jones 2021-06-10 13:29:19 +02:00
parent 37ca805969
commit bd65204760
4 changed files with 9 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
syndicate/driver-support.rkt
View File

@ -9,9 +9,9 @@
(define-logger syndicate/driver-support) (define-logger syndicate/driver-support)
(define (linked-thread peer (define (linked-thread thread-proc
thread-proc
#:name [name (gensym 'linked-thread)] #:name [name (gensym 'linked-thread)]
#:peer [peer (ref (entity/stop-on-retract #:name (list name 'monitor)))]
#:custodian [c (make-custodian)]) #:custodian [c (make-custodian)])
(define handle #f) (define handle #f)
(define armed? #t) (define armed? #t)

3
syndicate/drivers/tcp.rkt
View File

@ -38,7 +38,6 @@
(on-stop (log-syndicate/drivers/tcp-info "-listener on ~v ~v" host port)) (on-stop (log-syndicate/drivers/tcp-info "-listener on ~v ~v" host port))
(linked-thread (linked-thread
#:name (list (TcpInbound host port) 'thread) #:name (list (TcpInbound host port) 'thread)
(ref (entity #:name 'listen-monitor #:retract (lambda (_handle) (stop-current-facet))))
(lambda (facet) (lambda (facet)
(define listener (tcp-listen port 512 #t host)) (define listener (tcp-listen port 512 #t host))
(let loop () (let loop ()
@ -103,8 +102,6 @@
(linked-thread (linked-thread
#:name (list name 'input-thread) #:name (list name 'input-thread)
#:custodian custodian #:custodian custodian
(ref (entity #:name (list name 'socket-monitor)
#:retract (lambda (_handle) (stop-current-facet))))
(lambda (facet) (lambda (facet)
(let loop () (let loop ()
(define bs (read-bytes-avail i)) (define bs (read-bytes-avail i))

1
syndicate/drivers/timer.rkt
View File

@ -24,7 +24,6 @@
(linked-thread (linked-thread
#:name 'timer-driver-thread #:name 'timer-driver-thread
(ref (entity #:name 'timer-monitor #:retract (lambda (_handle) (stop-current-facet))))
(lambda (facet) (lambda (facet)
(struct pending-timer (deadline label) #:transparent) (struct pending-timer (deadline label) #:transparent)

11
syndicate/syntax.rkt
View File

@ -24,6 +24,7 @@
begin/dataflow begin/dataflow
define/dataflow define/dataflow
stop-when-true stop-when-true
entity/stop-on-retract
this-target this-target
at at
@ -123,6 +124,9 @@
(when test (when test
(stop-current-facet expr ...)))) (stop-current-facet expr ...))))
(define (entity/stop-on-retract #:name [name 'stop-on-retract] [k void])
(entity #:name name #:retract (lambda (_handle) (stop-current-facet (k)))))
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------
(define-for-syntax orig-insp (define-for-syntax orig-insp
@ -217,15 +221,14 @@
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings) (match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
(define name name-stx.N) (define name name-stx.N)
(define monitor (define monitor
(ref (entity #:name (list name 'monitor-in-parent) (ref (entity/stop-on-retract #:name (list name 'monitor-in-parent))))
#:retract (lambda (_handle) (stop-current-facet)))))
(define monitor-handle (turn-assert! this-turn monitor 'alive)) (define monitor-handle (turn-assert! this-turn monitor 'alive))
(turn-spawn! this-turn (turn-spawn! this-turn
#:name name #:name name
#:daemon? daemon.D #:daemon? daemon.D
#:link #:link
(entity #:name (list name 'monitor-in-child) (entity/stop-on-retract #:name
#:retract (lambda (_handle) (stop-current-facet))) (list name 'monitor-in-child))
(lambda () expr ...) (lambda () expr ...)
(hasheq monitor-handle #t)))))))]))) (hasheq monitor-handle #t)))))))])))