Skip to content

Instantly share code, notes, and snippets.

@tonyg
Forked from samdphillips/boring.rkt
Created August 26, 2021 07:27
Show Gist options
  • Save tonyg/338e6a19b3f44b3215afe2b0ceea20b9 to your computer and use it in GitHub Desktop.
Save tonyg/338e6a19b3f44b3215afe2b0ceea20b9 to your computer and use it in GitHub Desktop.
syndicate shutdown ...
#lang syndicate
(require racket/set)
(require/activate syndicate/drivers/external-event)
(provide shutdown!)
(define-logger top)
(define log-receiver
(make-log-receiver top-logger 'debug))
(spawn #:name "log-receiver"
(stop-when (asserted (stop 'log-receiver)))
(on (message (inbound (external-event log-receiver (list $log))))
(match log
[(vector level message _ _)
(printf "[~a] ~a~%" level message)])))
(assertion-struct shutdown (ch))
(assertion-struct stop (name))
(assertion-struct stopped (name))
(define shutdown-ch* (make-channel))
(define (shutdown!)
(define ch (make-channel))
(channel-put shutdown-ch* ch)
(channel-get ch))
(spawn #:name "shutdown-handler"
(on-start
(log-top-info "starting"))
(on (message (inbound (external-event shutdown-ch* (list $ack-ch))))
(assert! (shutdown ack-ch)))
(during
(shutdown $ack-ch)
(define/query-value pending-shutdown
(set 'server 'client)
(stopped $who)
(set-remove (pending-shutdown) who)
#:on-add
(log-top-info "saw stopped: ~a" who))
(begin/dataflow
(log-top-info "actors pending: ~a" (pending-shutdown)))
(stop-when-true
(set-empty? (pending-shutdown))
(channel-put ack-ch #t))
(on-start
(log-top-info "channel shutdown received")
(assert! (stop 'server))
(assert! (stop 'client)))))
(define-logger server #:parent top-logger)
(spawn #:name "server"
(stop-when (asserted (stop 'server))
(react (assert (stopped 'server)))
(log-server-warning "stopped"))
(on-stop
(log-server-warning "shutting down")))
(define-logger client #:parent top-logger)
(spawn #:name "client"
(stop-when (asserted (stop 'client))
(react (assert (stopped 'client)))
(log-client-warning "stopped"))
(on-stop
(log-client-warning "shutting down")))
#lang racket/base
(require (only-in (submod "boring.rkt" syndicate-main)
activate!)
(only-in "boring.rkt" shutdown!)
(only-in syndicate/ground
run-ground)
(only-in syndicate/lang
current-activated-modules
current-ground-dataspace))
(define syndicate-thd
(thread
(lambda ()
(parameterize ([current-ground-dataspace run-ground]
[current-activated-modules (make-hasheq)])
((current-ground-dataspace) activate!)))))
(with-handlers* ([exn:break? (lambda (e) (shutdown!))])
(thread-wait syndicate-thd))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment