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 (linked-thread peer
thread-proc
(define (linked-thread thread-proc
#:name [name (gensym 'linked-thread)]
#:peer [peer (ref (entity/stop-on-retract #:name (list name 'monitor)))]
#:custodian [c (make-custodian)])
(define handle #f)
(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))
(linked-thread
#:name (list (TcpInbound host port) 'thread)
(ref (entity #:name 'listen-monitor #:retract (lambda (_handle) (stop-current-facet))))
(lambda (facet)
(define listener (tcp-listen port 512 #t host))
(let loop ()
@ -103,8 +102,6 @@
(linked-thread
#:name (list name 'input-thread)
#:custodian custodian
(ref (entity #:name (list name 'socket-monitor)
#:retract (lambda (_handle) (stop-current-facet))))
(lambda (facet)
(let loop ()
(define bs (read-bytes-avail i))

1
syndicate/drivers/timer.rkt
View File

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

11
syndicate/syntax.rkt
View File

@ -24,6 +24,7 @@
begin/dataflow
define/dataflow
stop-when-true
entity/stop-on-retract
this-target
at
@ -123,6 +124,9 @@
(when test
(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
@ -217,15 +221,14 @@
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
(define name name-stx.N)
(define monitor
(ref (entity #:name (list name 'monitor-in-parent)
#:retract (lambda (_handle) (stop-current-facet)))))
(ref (entity/stop-on-retract #:name (list name 'monitor-in-parent))))
(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 (lambda (_handle) (stop-current-facet)))
(entity/stop-on-retract #:name
(list name 'monitor-in-child))
(lambda () expr ...)
(hasheq monitor-handle #t)))))))])))