From 921b84e05624d4119b2de6cebb8a570290f52a81 Mon Sep 17 00:00:00 2001
From: Sam Caldwell <samcaldwell@utexas.edu>
Date: Tue, 7 Mar 2017 12:59:39 -0500
Subject: [PATCH] Add upside-down relays

---
 racket/syndicate/upside-down.rkt | 53 +++++++++++++++++++++++++++-----
 1 file changed, 45 insertions(+), 8 deletions(-)

diff --git a/racket/syndicate/upside-down.rkt b/racket/syndicate/upside-down.rkt
index f5d855f..4eb00a2 100644
--- a/racket/syndicate/upside-down.rkt
+++ b/racket/syndicate/upside-down.rkt
@@ -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))))
\ No newline at end of file
+  (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))
\ No newline at end of file