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

Add upside-down relays

This commit is contained in:
Sam Caldwell 2017-03-07 12:59:39 -05:00
parent ea1b1bc072
commit 921b84e056
1 changed files with 45 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
racket/syndicate/upside-down.rkt
View File

@ -2,10 +2,12 @@
(provide (struct-out upside-down) (provide (struct-out upside-down)
upside-down-parenthesis upside-down-parenthesis
spawn-upside-down) spawn-upside-down
upside-down-relay)
(require "core.rkt") (require "core.rkt")
(require "trie.rkt") (require "trie.rkt")
(require "protocol/standard-relay.rkt")
#| #|
A module that takes actors to ... the upside down [1]. Actors in the upside down 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) (struct upside-down (v) #:transparent)
(define upside-down-parenthesis (open-parenthesis 1 struct:upside-down)) (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) (define (spawn-upside-down inner-spawn)
(make-actor (lambda () (make-actor (lambda ()
(define-values (proc initial-transition) (define-values (proc initial-transition)
@ -61,17 +85,30 @@ this facility for testing.
(match e (match e
[#f #f] [#f #f]
[(patch added removed) [(patch added removed)
(patch (trie-project added (upside-down (?!))) (patch (turn-trie-rightside-up added)
(trie-project removed (upside-down (?!))))] (turn-trie-rightside-up removed))]
[(message (upside-down v)) [(message (upside-down v))
(message v)])) (message v)]
[(message (inbound v))
(message (inbound v))]))
;; Trie -> Trie ;; Trie -> Trie
;; x ∈ T => (upside-down x) ∈ T' ;; x ∈ T => (upside-down x) ∈ T'
;; ?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 (turn-trie-upside-down t)
(define subscriptions (trie-project t (observe (?!)))) (define subscriptions (trie-project t (observe (?!))))
(trie-union (trie-prepend upside-down-parenthesis t) (define outgoing (trie-project t (?! (outbound ?))))
(trie-prepend observe-parenthesis (define inbound-interest (trie-project t (?! (observe (inbound ?)))))
(trie-prepend upside-down-parenthesis (trie-union-all (list (trie-prepend upside-down-parenthesis t)
subscriptions)))) (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))