TAttenuate

syndicate/actor.rkt

@@ -5,10 +5,6 @@
 (provide (except-out (struct-out entity) entity)
          (rename-out [make-entity entity])
 
-         (struct-out entity-ref)
-         attenuate-entity-ref
-         parse-Ref!
-
          actor-system
 
          actor?
@@ -63,6 +59,7 @@
 
 (require "rewrite.rkt")
 (require "engine.rkt")
+(require "entity-ref.rkt")
 (require "dataflow.rkt")
 (require "field.rkt")
 (require "support/counter.rkt")
@@ -80,9 +77,6 @@
    #:sync [entity-sync #f]
    #:data [entity-data (void)]))
 
-(struct entity-ref (relay target attenuation) #:transparent)
-(define (parse-Ref! r) (if (entity-ref? r) r (error 'parse-Ref! "Expected entity-ref; got ~v" r)))
-
 (struct outbound-assertion (handle peer [established? #:mutable]))
 
 (struct actor (id
@@ -471,10 +465,3 @@
 (define (deliver maybe-proc . args)
   (when maybe-proc
     (apply maybe-proc args)))
-
-;; TODO: prove to myself I've gotten the order correct. (Right-to-left, wasn't it?!?!)
-(define (attenuate-entity-ref r . caveats)
-  (match-define (entity-ref relay target previous-attenuation) r)
-  (if (null? caveats)
-      r
-      (entity-ref relay target (append previous-attenuation caveats))))

syndicate/distributed/tcp-server.rkt

@@ -8,6 +8,7 @@
 (require (only-in racket/list append-map))
 
 (require syndicate/relay)
+(require syndicate/rewrite)
 (require syndicate/sturdy)
 (require syndicate/schemas/gen/gatekeeper)
 (require syndicate/sturdy)

syndicate/entity-ref.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+;;; SPDX-License-Identifier: LGPL-3.0-or-later
+;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
+
+(provide (struct-out entity-ref)
+         parse-Ref!)
+
+(struct entity-ref (relay target attenuation) #:transparent)
+
+(define (parse-Ref! r)
+  (if (entity-ref? r)
+      r
+      (error 'parse-Ref! "Expected entity-ref; got ~v" r)))

syndicate/main.rkt

@@ -4,6 +4,7 @@
 #lang racket/base
 
 (provide (all-from-out "actor.rkt")
+         (all-from-out "entity-ref.rkt")
          (all-from-out "syntax.rkt")
          (all-from-out preserves)
          (all-from-out preserves-schema)
@@ -14,6 +15,7 @@
          :pattern)
 
 (require (except-in "actor.rkt" actor-system))
+(require "entity-ref.rkt")
 (require "syntax.rkt")
 (require preserves)
 (require preserves-schema)

syndicate/private/install.rkt

@@ -17,7 +17,7 @@
   (delete-directory/files output-directory #:must-exist? #f)
   (parameterize ((schema-compiler-plugin-mode 'meta))
     (batch-compile #:inputs (list (build-path syndicate-path "schemas/**.prs"))
-                   #:additional-modules (hash '(Actor) 'syndicate/actor)
+                   #:additional-modules (hash '(EntityRef) 'syndicate/entity-ref)
                    #:output-directory output-directory
                    #:plugins (list schema-compiler-plugin))))
 

syndicate/relay.rkt

@@ -11,6 +11,7 @@
 
 (require "main.rkt")
 (require "engine.rkt")
+(require "rewrite.rkt")
 (require "schemas/gen/protocol.rkt")
 (require (prefix-in sturdy: "schemas/gen/sturdy.rkt"))
 

syndicate/rewrite.rkt

@@ -2,12 +2,14 @@
 ;;; SPDX-License-Identifier: LGPL-3.0-or-later
 ;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
 
-(provide run-rewrites)
+(provide run-rewrites
+         attenuate-entity-ref)
 
 (require racket/match)
 (require racket/dict)
 (require preserves)
 
+(require "entity-ref.rkt")
 (require "schemas/gen/sturdy.rkt")
 
 (define (match-Pattern p v)
@@ -59,6 +61,9 @@
 (define (instantiate-Template t bindings)
   (let walk ((t t))
     (match t
+      [(Template-TAttenuate (TAttenuate t (Attenuation attenuation)))
+       (match-define (embedded v) (walk t))
+       (embedded (apply attenuate-entity-ref v attenuation))]
       [(Template-TRef (TRef name))
        (hash-ref bindings name (lambda () (error 'instantiate-Template "Missing binding: ~v" name)))]
       [(Template-Lit (Lit v)) v]
@@ -104,3 +109,10 @@
       [(cons stage remaining) (match (examine-alternatives stage v)
                                 [(? void?) (void)]
                                 [rewritten (loop remaining rewritten)])])))
+
+;; TODO: prove to myself I've gotten the order correct. (Right-to-left, wasn't it?!?!)
+(define (attenuate-entity-ref r . caveats)
+  (match-define (entity-ref relay target previous-attenuation) r)
+  (if (null? caveats)
+      r
+      (entity-ref relay target (append previous-attenuation caveats))))

syndicate/schemas/dataspace.prs

@@ -1,4 +1,4 @@
 version 1 .
-embeddedType Actor.Ref .
+embeddedType EntityRef.Ref .
 
 Observe = <Observe @pattern dataspace-patterns.Pattern @observer #!any>.

syndicate/schemas/gatekeeper.prs

@@ -1,5 +1,5 @@
 version 1 .
-embeddedType Actor.Ref .
+embeddedType EntityRef.Ref .
 
 Resolve = <resolve @sturdyref sturdy.SturdyRef @observer #!#!any>.
 Bind = <bind @oid any @key bytes @target #!any>.

syndicate/schemas/secure-chat-protocol.prs

@@ -1,5 +1,5 @@
 version 1 .
-embeddedType Actor.Ref .
+embeddedType EntityRef.Ref .
 
 UserId = int .
 

syndicate/schemas/simple-chat-protocol.prs

@@ -1,5 +1,5 @@
 version 1 .
-embeddedType Actor.Ref .
+embeddedType EntityRef.Ref .
 
 Present = <Present @username string>.
 Says = <Says @who string @what string>.

syndicate/schemas/sturdy.prs

@@ -36,7 +36,8 @@ PNot = <not @pattern Pattern>.
 PCompound = <compound @ctor ConstructorSpec @members PCompoundMembers>.
 PCompoundMembers = { any: Pattern ...:... }.
 
-Template = TRef / Lit / TCompound .
+Template = TAttenuate / TRef / Lit / TCompound .
+TAttenuate = <attenuate @template Template @attenuation Attenuation>.
 TRef = <ref @name symbol>.
 TCompound = <compound @ctor ConstructorSpec @members TCompoundMembers>.
 TCompoundMembers = { any: Template ...:... }.

syndicate/schemas/worker.prs

@@ -1,4 +1,4 @@
 version 1 .
-embeddedType Actor.Ref .
+embeddedType EntityRef.Ref .
 
 Instance = <Instance @name string @argument any>.