ref -> entity-ref

This commit is contained in:
Tony Garnock-Jones 2021-06-01 10:01:10 +02:00
parent d4af09e1b9
commit 568f97c2f6
1 changed files with 17 additions and 16 deletions

View File

@ -3,7 +3,7 @@
(provide (except-out (struct-out entity) entity) (provide (except-out (struct-out entity) entity)
(rename-out [make-entity entity]) (rename-out [make-entity entity])
(struct-out ref) (struct-out entity-ref)
parse-Ref parse-Ref
Ref->preserves Ref->preserves
@ -66,8 +66,8 @@
#:message [entity-message #f] #:message [entity-message #f]
#:sync [entity-sync #f])) #:sync [entity-sync #f]))
(struct ref (relay target attenuation) #:transparent) (struct entity-ref (relay target attenuation) #:transparent)
(define (parse-Ref r) (if (ref? r) r eof)) (define (parse-Ref r) (if (entity-ref? r) r eof))
(define (Ref->preserves r) r) (define (Ref->preserves r) r)
(struct outbound-assertion (handle peer [established? #:mutable])) (struct outbound-assertion (handle peer [established? #:mutable]))
@ -248,7 +248,7 @@
(hash-update! qs f (lambda (actions) (cons action actions)) '())) (hash-update! qs f (lambda (actions) (cons action actions)) '()))
(define (turn-ref turn entity [attenuation '()]) (define (turn-ref turn entity [attenuation '()])
(ref (turn-active-facet turn) entity attenuation)) (entity-ref (turn-active-facet turn) entity attenuation))
(define (turn-facet! turn boot-proc) (define (turn-facet! turn boot-proc)
(let ((new-facet (make-facet (facet-actor (turn-active-facet turn)) (turn-active-facet turn)))) (let ((new-facet (make-facet (facet-actor (turn-active-facet turn)) (turn-active-facet turn))))
@ -287,8 +287,9 @@
(field (actor-dataflow (facet-actor (turn-active-facet turn))) name initial-value)) (field (actor-dataflow (facet-actor (turn-active-facet turn))) name initial-value))
(define (turn-dataflow! turn action) (define (turn-dataflow! turn action)
(parameterize ((current-dataflow-subject-id action)) (define f (turn-active-facet turn))
(action turn))) (define (wrapped turn) (when (facet-live? f) (action turn)))
(parameterize ((current-dataflow-subject-id wrapped)) (wrapped turn)))
(define (turn-assert/dataflow! turn peer assertion-action) (define (turn-assert/dataflow! turn peer assertion-action)
(define handle #f) (define handle #f)
@ -305,16 +306,16 @@
handle) handle)
(define (turn-assert!* turn peer assertion handle) (define (turn-assert!* turn peer assertion handle)
(match (run-rewrites (ref-attenuation peer) assertion) (match (run-rewrites (entity-ref-attenuation peer) assertion)
[(? void?) (void)] [(? void?) (void)]
[rewritten [rewritten
(define a (outbound-assertion handle peer #f)) (define a (outbound-assertion handle peer #f))
(hash-set! (facet-outbound (turn-active-facet turn)) handle a) (hash-set! (facet-outbound (turn-active-facet turn)) handle a)
(turn-enqueue! turn (turn-enqueue! turn
(ref-relay peer) (entity-ref-relay peer)
(lambda (turn) (lambda (turn)
(set-outbound-assertion-established?! a #t) (set-outbound-assertion-established?! a #t)
(deliver (entity-assert (ref-target peer)) turn rewritten handle)))])) (deliver (entity-assert (entity-ref-target peer)) turn rewritten handle)))]))
(define (turn-retract! turn handle) (define (turn-retract! turn handle)
(when handle (when handle
@ -329,11 +330,11 @@
(define (turn-retract!* turn a) (define (turn-retract!* turn a)
(hash-remove! (facet-outbound (turn-active-facet turn)) (outbound-assertion-handle a)) (hash-remove! (facet-outbound (turn-active-facet turn)) (outbound-assertion-handle a))
(turn-enqueue! turn (turn-enqueue! turn
(ref-relay (outbound-assertion-peer a)) (entity-ref-relay (outbound-assertion-peer a))
(lambda (turn) (lambda (turn)
(when (outbound-assertion-established? a) (when (outbound-assertion-established? a)
(set-outbound-assertion-established?! a #f) (set-outbound-assertion-established?! a #f)
(deliver (entity-retract (ref-target (outbound-assertion-peer a))) (deliver (entity-retract (entity-ref-target (outbound-assertion-peer a)))
turn turn
(outbound-assertion-handle a)))))) (outbound-assertion-handle a))))))
@ -342,21 +343,21 @@
(define (turn-sync!* turn peer-to-sync-with peer-k) (define (turn-sync!* turn peer-to-sync-with peer-k)
(turn-enqueue! turn (turn-enqueue! turn
(ref-relay peer-to-sync-with) (entity-ref-relay peer-to-sync-with)
(lambda (turn) (lambda (turn)
(deliver (or (entity-sync (ref-target peer-to-sync-with)) (deliver (or (entity-sync (entity-ref-target peer-to-sync-with))
(lambda (turn peer-k) (turn-message! turn peer-k #t))) (lambda (turn peer-k) (turn-message! turn peer-k #t)))
turn turn
peer-k)))) peer-k))))
(define (turn-message! turn peer assertion) (define (turn-message! turn peer assertion)
(match (run-rewrites (ref-attenuation peer) assertion) (match (run-rewrites (entity-ref-attenuation peer) assertion)
[(? void?) (void)] [(? void?) (void)]
[rewritten [rewritten
(turn-enqueue! turn (turn-enqueue! turn
(ref-relay peer) (entity-ref-relay peer)
(lambda (turn) (lambda (turn)
(deliver (entity-message (ref-target peer)) turn rewritten)))])) (deliver (entity-message (entity-ref-target peer)) turn rewritten)))]))
(define (turn-freshen turn action) (define (turn-freshen turn action)
(when (turn-queues turn) (error 'turn-freshen "Attempt to freshen a non-stale turn")) (when (turn-queues turn) (error 'turn-freshen "Attempt to freshen a non-stale turn"))