Simpler stream connection protocol.

This commit is contained in:
Tony Garnock-Jones 2021-06-18 13:48:12 +02:00
parent 68db114840
commit 28901e9d31
11 changed files with 157 additions and 190 deletions

View File

@ -22,12 +22,12 @@
(establish-connection (establish-connection
ds (TcpRemote host port) ds (TcpRemote host port)
#:initial-mode (Mode-lines (LineMode-lf)) #:initial-mode (Mode-lines (LineMode-lf))
#:on-connected (lambda (source sink) #:on-connect (lambda (source sink)
(at ds (at ds
(on (message (RacketEvent (read-line-evt (current-input-port)) $vs)) (on (message (RacketEvent (read-line-evt (current-input-port)) $vs))
(match (car vs) (match (car vs)
[(? eof-object?) (stop-current-facet (log-info "EOF on stdin."))] [(? eof-object?) (stop-current-facet (log-info "EOF on stdin."))]
[line (send-line sink line)])))) [line (send-line sink line)]))))
#:on-rejected (lambda (message) (stop-current-facet (log-error "~a" message))) #:on-rejected (lambda (message) (stop-current-facet (log-error "~a" message)))
#:on-disconnect (lambda () (stop-current-facet (log-info "Disconnected"))) #:on-disconnect (lambda () (stop-current-facet (log-info "Disconnected")))
#:on-data (lambda (line _mode) #:on-data (lambda (line _mode)

View File

@ -1,26 +0,0 @@
#lang syndicate
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
(module+ main
(require racket/cmdline)
(require syndicate/drivers/tcp)
(define host "0.0.0.0")
(define port 5999)
(command-line #:once-each
[("--host" "-H") hostname "Set hostname to listen on"
(set! host hostname)]
[("--port" "-p") port-number "Set port number to listen on"
(set! port (string->number port-number))])
(standard-actor-system (ds)
(at ds
(assert (StreamListener (TcpLocal host port)
(make-connection-handler
(lambda (source sink)
(handle-connection source sink
#:on-data
(lambda (data mode)
(send-data sink data mode))))))))))

View File

@ -17,7 +17,7 @@
(standard-actor-system (ds) (standard-actor-system (ds)
(at ds (at ds
(stop-on (asserted (TcpListenError (TcpLocal host port) $message))) (stop-on (asserted (StreamListenerError (TcpLocal host port) $message)))
(during/spawn (StreamConnection $source $sink (TcpLocal host port)) (during/spawn (StreamConnection $source $sink (TcpLocal host port))
(handle-connection source sink (handle-connection source sink
#:on-data (lambda (data mode) (send-data sink data mode))))))) #:on-data (lambda (data mode) (send-data sink data mode)))))))

View File

@ -19,7 +19,7 @@
(standard-actor-system (ds) (standard-actor-system (ds)
(at ds (at ds
(stop-on (asserted (TcpListenError (TcpLocal host port) $message))) (stop-on (asserted (StreamListenerError (TcpLocal host port) $message)))
(during/spawn (StreamConnection $source $sink (TcpLocal host port)) (during/spawn (StreamConnection $source $sink (TcpLocal host port))
(handle-connection source sink (handle-connection source sink
#:initial-mode (Mode-lines (LineMode-lf)) #:initial-mode (Mode-lines (LineMode-lf))

View File

@ -26,7 +26,7 @@
(define spec (TcpLocal "0.0.0.0" 5999)) (define spec (TcpLocal "0.0.0.0" 5999))
(at ds (at ds
(stop-on (asserted (TcpListenError spec _))) (stop-on (asserted (StreamListenerError spec _)))
(during/spawn (StreamConnection $source $sink spec) (during/spawn (StreamConnection $source $sink spec)
#:name (list 'tcp-server source) #:name (list 'tcp-server source)
(run-relay #:packet-writer (lambda (bs) (send-data sink bs)) (run-relay #:packet-writer (lambda (bs) (send-data sink bs))

View File

@ -7,7 +7,6 @@
port-source port-source
port-sink port-sink
make-connection-handler
make-source make-source
make-sink make-sink
handle-connection handle-connection
@ -34,85 +33,25 @@
(require syndicate/service) (require syndicate/service)
(require syndicate/pattern) (require syndicate/pattern)
(require syndicate/driver-support) (require syndicate/driver-support)
(require syndicate/drivers/racket-event)
(require syndicate/schemas/gen/stream) (require syndicate/schemas/gen/stream)
(define-logger syndicate/drivers/stream) (define-logger syndicate/drivers/stream)
(provide-service [ds] (provide-service [ds]
(at ds ;; No active components.
(during/spawn (Observe (:pattern (StreamConnection ,_ ,_ ,$spec-pat)) _) )
#:name (list 'stream-listener spec-pat)
(match (pattern->constant spec-pat)
[(? void?) (stop-current-facet)]
[spec (at ds
(during (StreamSpecListenable spec)
(assert
(StreamListener spec
(make-connection-handler
(lambda (source sink)
(assert (StreamConnection source sink spec))))))))]))
(during/spawn (StreamConnection $app-source $app-sink $spec)
#:name (list 'stream-connection spec)
(at ds
(during (StreamSpecConnectable spec)
(assert (StreamConnect spec
(object #:name 'connection-peer
[(ConnectionHandler-connected sys-source sys-sink)
(at sys-source (assert (Source-sink app-sink)))
(at sys-sink (assert (Sink-source app-source)))]
[(ConnectionHandler-rejected message)
(log-syndicate/drivers/stream-error
"Connection to ~a rejected: ~a" spec message)
(at app-source (assert (StreamError message)))
(at app-sink (assert (StreamError message)))
(stop-current-facet)]))))))
;; I translate interest in StreamListener with a particular spec-pattern into a facet
;; that reacts to interest in StreamSpecListenable with a spec matching the spec-pattern
;; by asserting StreamSpecListenable with that spec.
(during (Observe (:pattern (StreamListener ,$spec-pat ,_)) _)
(define listenable-asserter
(object [bindings
(define spec
(pattern->constant spec-pat (lambda (_name index) (list-ref bindings index))))
(assert (StreamSpecListenable spec))]))
(assert
(Observe (:pattern
(Observe (:pattern (StreamSpecListenable ,,(:pattern (DLit ,spec-pat)))) _))
listenable-asserter)))
;; I translate interest in StreamConnect with a particular spec-pattern into a facet that
;; reacts to interest in StreamSpecConnectable with a spec matching the spec-pattern by
;; asserting StreamSpecConnectable with that spec.
(during (Observe (:pattern (StreamConnect ,$spec-pat ,_)) _)
(define connectable-asserter
(object [bindings
(define spec
(pattern->constant spec-pat (lambda (_name index) (list-ref bindings index))))
(assert (StreamSpecConnectable spec))]))
(assert
(Observe (:pattern
(Observe (:pattern (StreamSpecConnectable ,,(:pattern (DLit ,spec-pat)))) _))
connectable-asserter)))))
(define (make-connection-handler on-connected #:name [name (gensym 'connection-handler)])
(object #:name name
[(ConnectionHandler-connected source sink)
(on-connected source sink)]
[(ConnectionHandler-rejected message)
(error 'connection-handler "~a" message)]))
(define (port-source [port (current-input-port)] (define (port-source [port (current-input-port)]
#:initial-sink [initial-sink #f]
#:custodian [custodian #f] #:custodian [custodian #f]
#:name [name (list 'port-source (object-name port))]) #:name [name (list 'port-source (object-name port))])
(define active-sink #f) (define active-sink initial-sink)
(define issue-credit (start-inbound-relay #:custodian custodian (define issue-credit (start-inbound-relay #:custodian custodian
(lambda () active-sink) (lambda () active-sink)
port)) port))
(make-source #:name name (make-source #:name name
#:initial-sink initial-sink
#:on-connect (lambda (new-sink) (set! active-sink new-sink)) #:on-connect (lambda (new-sink) (set! active-sink new-sink))
#:on-credit issue-credit)) #:on-credit issue-credit))
@ -122,7 +61,7 @@
(define control-ch (make-async-channel)) (define control-ch (make-async-channel))
(linked-thread (linked-thread
#:name (cons 'input-thread (object-name port)) #:name (list 'input-thread (object-name port))
#:custodian custodian #:custodian custodian
#:peer (object #:name 'inbound-relay-monitor #:peer (object #:name 'inbound-relay-monitor
[#:asserted _ [#:asserted _
@ -196,12 +135,14 @@
issue-credit) issue-credit)
(define (port-sink [port (current-output-port)] (define (port-sink [port (current-output-port)]
#:initial-source [initial-source #f]
#:initial-credit [initial-credit (CreditAmount-unbounded)] #:initial-credit [initial-credit (CreditAmount-unbounded)]
#:initial-mode [initial-mode (Mode-bytes)] #:initial-mode [initial-mode (Mode-bytes)]
#:name [name (list 'port-sink (object-name port))]) #:name [name (list 'port-sink (object-name port))])
(define active-source #f) (define active-source initial-source)
(define relay (outbound-relay port)) (define relay (outbound-relay port))
(make-sink #:name name (make-sink #:name name
#:initial-source initial-source
#:on-connect #:on-connect
(lambda (new-source) (lambda (new-source)
(set! active-source new-source) (set! active-source new-source)
@ -349,7 +290,7 @@
(define (establish-connection ds spec (define (establish-connection ds spec
#:name [name (gensym 'establish-connection)] #:name [name (gensym 'establish-connection)]
#:on-connected [on-connected (lambda (source sink) (void))] #:on-connect [on-connect (lambda (source sink) (void))]
#:on-rejected [on-rejected #f] #:on-rejected [on-rejected #f]
#:on-disconnect [on-disconnect #f] #:on-disconnect [on-disconnect #f]
@ -359,24 +300,39 @@
#:initial-mode [initial-mode (Mode-bytes)] #:initial-mode [initial-mode (Mode-bytes)]
#:on-data on-data #:on-data on-data
#:on-eof [on-eof void]) #:on-eof [on-eof void])
(define peer (define connection-state 'pending)
(object #:name name (begin/dataflow (log-info "connection-state ~a" connection-state))
[#:asserted (ConnectionHandler-connected source sink) (define (transition new-state)
(handle-connection source sink (when (not (equal? connection-state new-state))
#:on-disconnect on-disconnect (match* (connection-state new-state)
#:on-error on-error [('pending 'connected)
#:on-credit on-credit (when initial-credit (send-credit (peer-source) initial-credit initial-mode))
#:initial-credit initial-credit (on-connect (peer-source) (peer-sink))]
#:initial-mode initial-mode [(_ 'disconnected)
#:on-data on-data (on-disconnect)]
#:on-eof on-eof) [('pending (list 'error m))
(stop-facet ringing-facet) (on-rejected m)]
(on-connected source sink)] [(_ (list 'error m))
[#:asserted (ConnectionHandler-rejected message) (on-error m)])))
(stop-facet ringing-facet)
((or on-rejected (lambda (_message) (stop-current-facet))) message)])) (define-field peer-source #f)
(define ringing-facet (react (at ds (assert (StreamConnect spec peer))))) (define-field peer-sink #f)
(void)) (begin/dataflow
(when (and (peer-source) (peer-sink))
(transition 'connected)))
(define source (make-source #:name (list 'source name)
#:on-connect peer-sink
#:on-disconnect (lambda () (transition 'disconnected))
#:on-error (lambda (m) (transition (list 'error m)))
#:on-credit on-credit))
(define sink (make-sink #:name (list 'sink name)
#:on-connect peer-source
#:on-disconnect (lambda () (transition 'disconnected))
#:on-error (lambda (m) (transition (list 'error m)))
#:on-data on-data
#:on-eof on-eof))
(at ds (assert (StreamConnection source sink spec))))
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------

View File

@ -22,45 +22,71 @@
(provide-service [ds] (provide-service [ds]
(with-services [syndicate/drivers/stream] (with-services [syndicate/drivers/stream]
(at ds (at ds
(during/spawn (StreamListener (TcpLocal $host $port) $peer) ;; TODO: this is annoying. We have to pay attention to the *syntactic* structure of the
;; listener's pattern in order to match all possible variants:
;; - `variable`, where `variable`'s value matches `(TcpLocal _ _)`
;; - `(TcpLocal variable1 variable2)`
;; - `(TcpLocal "hostname" variable)`
;; - `(TcpLocal variable 1234)`
;; - `(TcpLocal "hostname" 1234)`
;;
;; POSSIBLE SOLUTION: have pattern analysis check to see if there are any binds or
;; discards within a constructor application; if there are none, it may as well be a
;; constant literal, so make it one. This is what the earlier Syndicate/js
;; implementations do (because they don't have a compile-time constructor registry and
;; have to decide whether to assume a compound or just evaluate some expression), and it
;; works fine there.
(during/spawn (Observe (:pattern (StreamConnection ,_ ,_ (TcpLocal ,$host-pat ,$port-pat))) _)
#:match [host (pattern->constant host-pat)]
#:match [port (pattern->constant port-pat)]
#:when (not (or (void? host) (void? port)))
#:name (TcpLocal host port) #:name (TcpLocal host port)
(run-listener ds peer host port)) (run-listener ds host port))
(during/spawn (StreamConnect (TcpRemote $host $port) $peer) (during/spawn
(Observe (:pattern (StreamConnection ,_ ,_ ,(DLit (TcpLocal $host $port)))) _)
#:name (TcpLocal host port)
(run-listener ds host port))
(during/spawn (StreamConnection $source $sink (TcpRemote $host $port))
#:name (TcpRemote host port) #:name (TcpRemote host port)
(run-outbound ds peer host port))))) (run-outbound ds source sink host port)))))
(define (run-listener ds peer host port) (define (run-listener ds host port)
(on-start (log-syndicate/drivers/tcp-info "+listener on ~v ~v" host port)) (define spec (TcpLocal host port))
(on-stop (log-syndicate/drivers/tcp-info "-listener on ~v ~v" host port)) (on-start (log-syndicate/drivers/tcp-info "+listener on ~v" spec))
(on-stop (log-syndicate/drivers/tcp-info "-listener on ~v" spec))
(linked-thread (linked-thread
#:name (list 'listen-thread host port) #:name (list 'listen-thread host port)
(lambda (facet) (lambda (facet)
(with-connection-error-guard ds peer (with-connection-error-guard ds
(lambda (message) (lambda (message)
(turn! facet (lambda () (turn! facet (lambda ()
(at ds (assert (TcpListenError (TcpLocal host port) message))) (log-syndicate/drivers/tcp-warning "~a" message)
(at peer (assert (ConnectionHandler-rejected message)))))) (at ds (assert (StreamListenerError spec message))))))
(lambda () (lambda ()
(define listener (tcp-listen port 512 #t host)) (define listener (tcp-listen port 512 #t host))
(lambda () (lambda ()
(turn! facet (lambda ()
(at ds (assert (StreamListenerReady spec)))))
(let loop () (let loop ()
(define connection-custodian (make-custodian)) (define connection-custodian (make-custodian))
(define-values (i o) (parameterize ((current-custodian connection-custodian)) (define-values (i o) (parameterize ((current-custodian connection-custodian))
(tcp-accept listener))) (tcp-accept listener)))
(turn! facet (lambda () (spawn-connection ds connection-custodian i o peer))) (turn! facet (lambda () (spawn-connection ds connection-custodian i o spec #f #f)))
(loop)))))))) (loop))))))))
(define (tcp-ends p) (define (tcp-ends p)
(call-with-values (lambda () (tcp-addresses p #t)) (call-with-values (lambda () (tcp-addresses p #t))
(lambda (lh lp rh rp) (list (TcpLocal lh lp) (TcpRemote rh rp))))) (lambda (lh lp rh rp) (list (TcpLocal lh lp) (TcpRemote rh rp)))))
(define (spawn-connection ds custodian i o peer) (define (spawn-connection ds custodian i o spec peer-source peer-sink)
(match-define (and ends (list (and local-end (TcpLocal local-host local-port)) (match-define (and ends (list (and local-end (TcpLocal local-host local-port))
(and remote-end (TcpRemote remote-host remote-port)))) (and remote-end (TcpRemote remote-host remote-port))))
(tcp-ends i)) (tcp-ends i))
(define name (format "[~a:~a::~a:~a]" local-host local-port remote-host remote-port)) (define name (format "[~a:~a::~a:~a]" local-host local-port remote-host remote-port))
(log-syndicate/drivers/tcp-info "Connection ~a established" name) (log-syndicate/drivers/tcp-info "TCP socket ~a for ~a established" name spec)
(spawn #:name name (spawn #:name name
(actor-add-exit-hook! this-actor (lambda () (actor-add-exit-hook! this-actor (lambda ()
(close-input-port i) (close-input-port i)
@ -72,28 +98,31 @@
(react (on-stop (facet-count (- (facet-count) 1)) (react (on-stop (facet-count (- (facet-count) 1))
(close-input-port i)) (close-input-port i))
(set! source (port-source i #:custodian custodian)) (set! source (port-source i #:initial-sink peer-sink #:custodian custodian))
(at ds (assert (TcpPeerInfo source local-end remote-end)))) (at ds (assert (TcpPeerInfo source local-end remote-end))))
(react (on-stop (facet-count (- (facet-count) 1)) (react (on-stop (facet-count (- (facet-count) 1))
(close-output-port o)) (close-output-port o))
(set! sink (port-sink o)) (set! sink (port-sink o #:initial-source peer-source))
(at ds (assert (TcpPeerInfo sink local-end remote-end)))) (at ds (assert (TcpPeerInfo sink local-end remote-end))))
(at peer (when (TcpLocal? spec)
(assert #:when (positive? (facet-count)) (at ds
(ConnectionHandler-connected source sink))))) (assert #:when (positive? (facet-count)) (StreamConnection source sink spec))))))
(define (with-connection-error-guard ds peer error-proc proc) (define (with-connection-error-guard ds error-proc proc)
((with-handlers ([exn:fail:network? (lambda (e) (lambda () (error-proc (exn->string e))))]) ((with-handlers ([exn:fail:network? (lambda (e) (lambda () (error-proc (exn->string e))))])
(proc)))) (proc))))
(define (run-outbound ds peer host port) (define (run-outbound ds source sink host port)
(with-connection-error-guard ds peer (with-connection-error-guard ds
(lambda (message) (lambda (message)
(at peer (assert (ConnectionHandler-rejected message)))) (log-syndicate/drivers/tcp-warning "~a" message)
(at source (assert (StreamError message)))
(at sink (assert (StreamError message))))
(lambda () (lambda ()
(define connection-custodian (make-custodian)) (define connection-custodian (make-custodian))
(define-values (i o) (parameterize ((current-custodian connection-custodian)) (define-values (i o) (parameterize ((current-custodian connection-custodian))
(tcp-connect host port))) (tcp-connect host port)))
(lambda () (spawn-connection ds connection-custodian i o peer))))) (lambda ()
(spawn-connection ds connection-custodian i o (TcpRemote host port) source sink)))))

View File

@ -1,24 +1,14 @@
version 1 . version 1 .
embeddedType EntityRef.Ref . embeddedType EntityRef.Ref .
; Assertions ; Assertion:
StreamConnection = <stream-connection @source #!Source @sink #!Sink @spec any>. StreamConnection = <stream-connection @source #!Source @sink #!Sink @spec any>.
StreamSpecListenable = <stream-spec-listenable @spec any>.
StreamSpecConnectable = <stream-spec-connectable @spec any>.
; Assertion ; Assertions:
StreamListener = <stream-listener @spec any @handle #!ConnectionHandler>. StreamListenerReady = <stream-listener-ready @spec any>.
StreamListenerError = <stream-listener-error @spec any @message string>.
; Assertion ; Assertion:
StreamConnect = <stream-connect @spec any @handle #!ConnectionHandler>.
; Assertion
ConnectionHandler =
/ @connected <stream-connected @source #!Source @sink #!Sink>
/ @rejected <stream-rejected @message string>
.
; Assertion
StreamError = <error @message string>. StreamError = <error @message string>.
Source = Source =
@ -40,7 +30,9 @@ Sink =
/ <eof> / <eof>
. .
; Value:
CreditAmount = @count int / @unbounded =unbounded . CreditAmount = @count int / @unbounded =unbounded .
; Value:
Mode = =bytes / @lines LineMode / <packet @size int> / <object @description any>. Mode = =bytes / @lines LineMode / <packet @size int> / <object @description any>.
LineMode = =lf / =crlf . LineMode = =lf / =crlf .

View File

@ -5,5 +5,3 @@ TcpRemote = <tcp-remote @host string @port int>.
TcpLocal = <tcp-local @host string @port int>. TcpLocal = <tcp-local @host string @port int>.
TcpPeerInfo = <tcp-peer @handle #!any @local TcpLocal @remote TcpRemote>. TcpPeerInfo = <tcp-peer @handle #!any @local TcpLocal @remote TcpRemote>.
TcpListenError = <tcp-listen-error @spec TcpLocal @message string>.

View File

@ -5,7 +5,8 @@
(provide (for-syntax <when> (provide (for-syntax <when>
<name> <name>
<daemon?> <daemon?>
<link?>)) <link?>
<matches>))
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require (for-syntax syntax/parse)) (require (for-syntax syntax/parse))
@ -25,4 +26,7 @@
(define-splicing-syntax-class <link?> (define-splicing-syntax-class <link?>
(pattern (~seq #:link? L)) (pattern (~seq #:link? L))
(pattern (~seq) #:attr L #'#f))) (pattern (~seq) #:attr L #'#f))
(define-splicing-syntax-class <matches>
(pattern (~seq (~seq #:match [pattern-pieces ...+ discriminant]) ...))))

View File

@ -212,8 +212,10 @@
(define-syntax-rule (on-stop expr ...) (define-syntax-rule (on-stop expr ...)
(facet-on-stop! this-facet (lambda () expr ...))) (facet-on-stop! this-facet (lambda () expr ...)))
(define-syntax-rule (sync! peer expr ...) (define-syntax (sync! stx)
(turn-sync! this-turn peer (lambda (_reply) expr ...))) (syntax-parse stx
[(_ peer expr ...)
(syntax/loc stx (turn-sync! this-turn peer (lambda (_reply) expr ...)))]))
(define-for-syntax (with-valid-this-target orig-stx result-stx) (define-for-syntax (with-valid-this-target orig-stx result-stx)
;; Invoke this-target transformer for its side effect: when it's ;; Invoke this-target transformer for its side effect: when it's
@ -233,32 +235,44 @@
(define-syntax (spawn stx) (define-syntax (spawn stx)
(syntax-parse stx (syntax-parse stx
[(_ name:<name> daemon:<daemon?>) [(_ matches:<matches> condition:<when> name:<name> daemon:<daemon?>)
(raise-syntax-error #f "Need body in spawn")] (raise-syntax-error #f "Need body in spawn")]
[(_ name:<name> daemon:<daemon?> setup-expr ...) [(_ matches:<matches> condition:<when> name:<name> daemon:<daemon?> setup-expr ...)
#'(turn-spawn! #:name name.N #'(nested-matches
#:daemon? daemon.D [[matches.pattern-pieces ... matches.discriminant] ...]
this-turn (when condition.E
(lambda () (turn-spawn! #:name name.N
(syntax-parameterize ([this-target illegal-use-of-this-target]) #:daemon? daemon.D
setup-expr ...)))])) this-turn
(lambda ()
(syntax-parameterize ([this-target illegal-use-of-this-target])
setup-expr ...)))))]))
(define-syntax (spawn/link stx) (define-syntax (spawn/link stx)
(syntax-parse stx (syntax-parse stx
[(_ name-stx:<name> daemon:<daemon?> setup-expr ...) [(_ matches:<matches> condition:<when> name-stx:<name> daemon:<daemon?> setup-expr ...)
#`(begin #`(nested-matches
(define name name-stx.N) [[matches.pattern-pieces ... matches.discriminant] ...]
(define monitor (ref (entity/stop-on-retract #:name (list name 'monitor-in-parent)))) (when condition.E
(define monitor-handle (turn-assert! this-turn monitor 'alive)) (define name name-stx.N)
(turn-spawn! this-turn (define monitor (ref (entity/stop-on-retract #:name (list name 'monitor-in-parent))))
#:name name (define monitor-handle (turn-assert! this-turn monitor 'alive))
#:daemon? daemon.D (turn-spawn! this-turn
#:link #:name name
(entity/stop-on-retract #:name (list name 'monitor-in-child)) #:daemon? daemon.D
(lambda () #:link
(syntax-parameterize ([this-target illegal-use-of-this-target]) (entity/stop-on-retract #:name (list name 'monitor-in-child))
setup-expr ...)) (lambda ()
(hasheq monitor-handle #t)))])) (syntax-parameterize ([this-target illegal-use-of-this-target])
setup-expr ...))
(hasheq monitor-handle #t))))]))
(define-syntax nested-matches
(syntax-rules ()
[(_ [] body ...)
(begin body ...)]
[(_ [[p ... e] more ...] body ...)
(match e [p ... (nested-matches [more ...] body ...)] [_ (void)])]))
(define-syntax-rule (begin/dataflow expr ...) (define-syntax-rule (begin/dataflow expr ...)
(turn-dataflow! this-turn (lambda () expr ...))) (turn-dataflow! this-turn (lambda () expr ...)))
@ -364,12 +378,12 @@
(define-syntax during/spawn (define-syntax during/spawn
(lambda (stx) (lambda (stx)
(syntax-parse stx (syntax-parse stx
[(_ pat name-stx:<name> daemon:<daemon?> expr ...) [(_ pat expr ...)
(quasisyntax/loc stx (quasisyntax/loc stx
(assert (Observe (:pattern pat) (assert (Observe (:pattern pat)
(ref (during* (lambda (bindings) (ref (during* (lambda (bindings)
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings) (match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
(spawn/link #:name name-stx.N #:daemon? daemon.D expr ...)))))))]))) (spawn/link expr ...)))))))])))
(define (during* f #:name [name '?]) (define (during* f #:name [name '?])
(define assertion-map (make-hash)) (define assertion-map (make-hash))