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

Further adaptation to recent Preserves changes

This commit is contained in:
Tony Garnock-Jones 2021-06-08 16:09:59 +02:00
parent 92eab82b1f
commit ef66c1d358
2 changed files with 26 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
syndicate/engine.rkt
View File

@ -57,6 +57,9 @@
(exit 1)) (exit 1))
(define (queue-task! e thunk) (define (queue-task! e thunk)
(thread-send (engine-thread e) thunk)) (thread-send (engine-thread e)
thunk
(lambda ()
(log-syndicate/engine-warning "Attempt to enqueue task for dead engine ~v" e))))
(define *dead-engine* (make-engine 0)) (define *dead-engine* (make-engine 0))

40
syndicate/relay.rkt
View File

@ -122,7 +122,7 @@
(define rewrite-ref-in (define rewrite-ref-in
(action (tr wire-ref save!) (action (tr wire-ref save!)
(match wire-ref (match wire-ref
[(sturdy:WireRef-mine oid) [(sturdy:WireRef-mine (sturdy:Oid oid))
(define ws (grab (tunnel-relay-imported-references tr) (define ws (grab (tunnel-relay-imported-references tr)
membrane-oid-map membrane-oid-map
oid oid
@ -131,7 +131,7 @@
(wire-symbol oid (turn-ref this-turn (make-relay-entity tr oid)) 0)))) (wire-symbol oid (turn-ref this-turn (make-relay-entity tr oid)) 0))))
(save! ws) (save! ws)
(wire-symbol-ref ws)] (wire-symbol-ref ws)]
[(sturdy:WireRef-yours oid attenuation) [(sturdy:WireRef-yours (sturdy:Oid oid) attenuation)
(define r (lookup-local tr oid)) (define r (lookup-local tr oid))
(if (or (null? attenuation) (eq? *inert-ref* r)) (if (or (null? attenuation) (eq? *inert-ref* r))
r r
@ -143,25 +143,26 @@
(action (tr packet) (action (tr packet)
(match (parse-Turn packet) (match (parse-Turn packet)
[(? eof-object?) (error 'handle-packet "Invalid IO.Turn")] [(? eof-object?) (error 'handle-packet "Invalid IO.Turn")]
[wire-turn [(Turn wire-turn)
(for [(ev (in-list wire-turn))] (for [(ev (in-list wire-turn))]
(match-define (TurnEvent oid event) ev) (log-info "~v" ev)
(match-define (TurnEvent (Oid oid) event) ev)
(define r (lookup-local tr oid)) (define r (lookup-local tr oid))
(match event (match event
[(Event-Assert (Assert assertion remote-handle)) [(Event-Assert (Assert (Assertion assertion) (Handle remote-handle)))
(define-values (a imported) (rewrite-in this-turn tr assertion)) (define-values (a imported) (rewrite-in this-turn tr assertion))
(hash-set! (tunnel-relay-inbound-assertions tr) (hash-set! (tunnel-relay-inbound-assertions tr)
remote-handle remote-handle
(inbound (turn-assert! this-turn r a) (inbound (turn-assert! this-turn r a)
imported))] imported))]
[(Event-Retract (Retract remote-handle)) [(Event-Retract (Retract (Handle remote-handle)))
(define i (hash-ref (tunnel-relay-inbound-assertions tr) remote-handle #f)) (define i (hash-ref (tunnel-relay-inbound-assertions tr) remote-handle #f))
(when (not i) (error 'handle-packet "Peer retracted invalid handle ~a" remote-handle)) (when (not i) (error 'handle-packet "Peer retracted invalid handle ~a" remote-handle))
(hash-remove! (tunnel-relay-inbound-assertions tr) remote-handle) (hash-remove! (tunnel-relay-inbound-assertions tr) remote-handle)
(for [(ws (in-list (inbound-imported i)))] (for [(ws (in-list (inbound-imported i)))]
(drop (tunnel-relay-imported-references tr) ws)) (drop (tunnel-relay-imported-references tr) ws))
(turn-retract! this-turn (inbound-local-handle i))] (turn-retract! this-turn (inbound-local-handle i))]
[(Event-Message (Message body)) [(Event-Message (Message (Assertion body)))
(define-values (a imported) (rewrite-in this-turn tr body)) (define-values (a imported) (rewrite-in this-turn tr body))
(when (not (null? imported)) (when (not (null? imported))
(error 'handle-packet "Cannot receive transient reference")) (error 'handle-packet "Cannot receive transient reference"))
@ -207,14 +208,14 @@
(set-tunnel-relay-next-local-oid! tr (+ oid 1)) (set-tunnel-relay-next-local-oid! tr (+ oid 1))
(wire-symbol oid local-ref 0)))) (wire-symbol oid local-ref 0))))
(save! ws) (save! ws)
(sturdy:WireRef-mine (wire-symbol-oid ws))) (sturdy:WireRef-mine (sturdy:Oid (wire-symbol-oid ws))))
(define (rewrite-ref-out tr local-ref transient? save!) (define (rewrite-ref-out tr local-ref transient? save!)
(define re (entity-data (entity-ref-target local-ref))) (define re (entity-data (entity-ref-target local-ref)))
(cond [(or (not (relay-entity? re)) (not (eq? (relay-entity-relay re) tr))) (cond [(or (not (relay-entity? re)) (not (eq? (relay-entity-relay re) tr)))
(rewrite-ref-out* tr local-ref transient? save!)] (rewrite-ref-out* tr local-ref transient? save!)]
[(null? (entity-ref-attenuation local-ref)) [(null? (entity-ref-attenuation local-ref))
(sturdy:WireRef-yours (relay-entity-oid re) '())] (sturdy:WireRef-yours (sturdy:Oid (relay-entity-oid re)) '())]
[else [else
;; we may trust the peer to enforce attenuation on our ;; we may trust the peer to enforce attenuation on our
;; behalf, in which case we can return (sturdy:WireRef-yours ;; behalf, in which case we can return (sturdy:WireRef-yours
@ -238,20 +239,21 @@
(define (make-relay-entity tr oid) (define (make-relay-entity tr oid)
(entity #:name (list (tunnel-relay-name tr) oid) (entity #:name (list (tunnel-relay-name tr) oid)
#:assert (action (assertion handle) #:assert (action (assertion handle)
(send-event tr (Event-Assert (Assert (register tr assertion handle) handle)))) (send-event tr (Event-Assert
(Assert (Assertion (register tr assertion handle))
(Handle handle)))))
#:retract (action (handle) #:retract (action (handle)
(deregister tr handle) (deregister tr handle)
(send-event tr (Event-Retract (Retract handle)))) (send-event tr (Event-Retract (Retract (Handle handle)))))
#:message (action (body) #:message (action (body)
(send-event tr (Event-Message (Message (register tr body #f))))) (send-event tr (Event-Message (Message (Assertion (register tr body #f))))))
#:sync (action (peer) #:sync (action (peer)
(define exported #f) (define exported #f)
(define (save! ws) (set! exported ws)) (define (save! ws) (set! exported ws))
(define spe (sync-peer-entity tr oid peer (lambda () exported))) (define spe (sync-peer-entity tr oid peer (lambda () exported)))
(send-event tr (send-event tr
(Event-Sync (Event-Sync
(Sync (embedded (Sync (rewrite-ref-out tr (turn-ref this-turn spe) #f save!)))))
(rewrite-ref-out tr (turn-ref this-turn spe) #f save!))))))
#:data (relay-entity tr oid))) #:data (relay-entity tr oid)))
(define (sync-peer-entity tr oid peer get-export) (define (sync-peer-entity tr oid peer get-export)
@ -286,10 +288,12 @@
(turn-assert! this-turn (turn-assert! this-turn
then then
(and initial-oid (and initial-oid
(embedded (rewrite-ref-in this-turn (embedded
tr (rewrite-ref-in this-turn
(sturdy:WireRef-mine initial-oid) tr
(lambda (_ws) (void)))))))))) (sturdy:WireRef-mine
(sturdy:Oid initial-oid))
(lambda (_ws) (void))))))))))
(define-syntax-rule (D v0) (define-syntax-rule (D v0)
(let ((v v0)) (let ((v v0))