Add upside-down relays
This commit is contained in:
parent
ea1b1bc072
commit
921b84e056
|
@ -2,10 +2,12 @@
|
|||
|
||||
(provide (struct-out upside-down)
|
||||
upside-down-parenthesis
|
||||
spawn-upside-down)
|
||||
spawn-upside-down
|
||||
upside-down-relay)
|
||||
|
||||
(require "core.rkt")
|
||||
(require "trie.rkt")
|
||||
(require "protocol/standard-relay.rkt")
|
||||
|
||||
#|
|
||||
A module that takes actors to ... the upside down [1]. Actors in the upside down
|
||||
|
@ -19,6 +21,28 @@ this facility for testing.
|
|||
(struct upside-down (v) #:transparent)
|
||||
(define upside-down-parenthesis (open-parenthesis 1 struct:upside-down))
|
||||
|
||||
;; during assertions (upside-down (outbound X)) assert (outbound X)
|
||||
;; on messages (message (upside-down (outbound X))) send (message (outbound X))
|
||||
;; during assertions (upside-down (observe (inbound X))) assert
|
||||
;; (observe (inbound X))
|
||||
(define upside-down-relay
|
||||
(actor (lambda (e s)
|
||||
(define (upside-down-relay-trie t)
|
||||
(define outbounds (trie-project t (?! (outbound ?))))
|
||||
(define subscriptions
|
||||
(trie-project t (upside-down (?! (observe (inbound ?))))))
|
||||
(trie-union outbounds subscriptions))
|
||||
(match e
|
||||
[(message (upside-down (outbound x)))
|
||||
(transition #f (list (message (outbound x))))]
|
||||
[(patch added removed)
|
||||
(transition #f (list (patch (upside-down-relay-trie added)
|
||||
(upside-down-relay-trie removed))))]
|
||||
[_ #f]))
|
||||
#f
|
||||
(list (patch-seq (sub (upside-down (outbound ?)))
|
||||
(sub (upside-down (observe (inbound ?))))))))
|
||||
|
||||
(define (spawn-upside-down inner-spawn)
|
||||
(make-actor (lambda ()
|
||||
(define-values (proc initial-transition)
|
||||
|
@ -61,17 +85,30 @@ this facility for testing.
|
|||
(match e
|
||||
[#f #f]
|
||||
[(patch added removed)
|
||||
(patch (trie-project added (upside-down (?!)))
|
||||
(trie-project removed (upside-down (?!))))]
|
||||
(patch (turn-trie-rightside-up added)
|
||||
(turn-trie-rightside-up removed))]
|
||||
[(message (upside-down v))
|
||||
(message v)]))
|
||||
(message v)]
|
||||
[(message (inbound v))
|
||||
(message (inbound v))]))
|
||||
|
||||
;; Trie -> Trie
|
||||
;; x ∈ T => (upside-down x) ∈ T'
|
||||
;; ?x ∈ T => ?(upside-down x) ∈ T'
|
||||
;; (outbound x) ∈ T => (outbound x) ∈ T'
|
||||
;; (observe (inbound x)) ∈ T => (observe (inbound x)) ∈ T'
|
||||
(define (turn-trie-upside-down t)
|
||||
(define subscriptions (trie-project t (observe (?!))))
|
||||
(trie-union (trie-prepend upside-down-parenthesis t)
|
||||
(trie-prepend observe-parenthesis
|
||||
(trie-prepend upside-down-parenthesis
|
||||
subscriptions))))
|
||||
(define outgoing (trie-project t (?! (outbound ?))))
|
||||
(define inbound-interest (trie-project t (?! (observe (inbound ?)))))
|
||||
(trie-union-all (list (trie-prepend upside-down-parenthesis t)
|
||||
(trie-prepend observe-parenthesis
|
||||
(trie-prepend upside-down-parenthesis
|
||||
subscriptions))
|
||||
outgoing
|
||||
inbound-interest)))
|
||||
|
||||
(define (turn-trie-rightside-up t)
|
||||
(define upside-downs (trie-project t (upside-down (?!))))
|
||||
(define inbounds (trie-project t (?! (inbound ?))))
|
||||
(trie-union upside-downs inbounds))
|
Loading…
Reference in New Issue