TAttenuate
This commit is contained in:
parent
fff4b05036
commit
e8a2e00fa2
|
@ -5,10 +5,6 @@
|
||||||
(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 entity-ref)
|
|
||||||
attenuate-entity-ref
|
|
||||||
parse-Ref!
|
|
||||||
|
|
||||||
actor-system
|
actor-system
|
||||||
|
|
||||||
actor?
|
actor?
|
||||||
|
@ -63,6 +59,7 @@
|
||||||
|
|
||||||
(require "rewrite.rkt")
|
(require "rewrite.rkt")
|
||||||
(require "engine.rkt")
|
(require "engine.rkt")
|
||||||
|
(require "entity-ref.rkt")
|
||||||
(require "dataflow.rkt")
|
(require "dataflow.rkt")
|
||||||
(require "field.rkt")
|
(require "field.rkt")
|
||||||
(require "support/counter.rkt")
|
(require "support/counter.rkt")
|
||||||
|
@ -80,9 +77,6 @@
|
||||||
#:sync [entity-sync #f]
|
#:sync [entity-sync #f]
|
||||||
#:data [entity-data (void)]))
|
#: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 outbound-assertion (handle peer [established? #:mutable]))
|
||||||
|
|
||||||
(struct actor (id
|
(struct actor (id
|
||||||
|
@ -471,10 +465,3 @@
|
||||||
(define (deliver maybe-proc . args)
|
(define (deliver maybe-proc . args)
|
||||||
(when maybe-proc
|
(when maybe-proc
|
||||||
(apply maybe-proc args)))
|
(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))))
|
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
(require (only-in racket/list append-map))
|
(require (only-in racket/list append-map))
|
||||||
|
|
||||||
(require syndicate/relay)
|
(require syndicate/relay)
|
||||||
|
(require syndicate/rewrite)
|
||||||
(require syndicate/sturdy)
|
(require syndicate/sturdy)
|
||||||
(require syndicate/schemas/gen/gatekeeper)
|
(require syndicate/schemas/gen/gatekeeper)
|
||||||
(require syndicate/sturdy)
|
(require syndicate/sturdy)
|
||||||
|
|
|
@ -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)))
|
|
@ -4,6 +4,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide (all-from-out "actor.rkt")
|
(provide (all-from-out "actor.rkt")
|
||||||
|
(all-from-out "entity-ref.rkt")
|
||||||
(all-from-out "syntax.rkt")
|
(all-from-out "syntax.rkt")
|
||||||
(all-from-out preserves)
|
(all-from-out preserves)
|
||||||
(all-from-out preserves-schema)
|
(all-from-out preserves-schema)
|
||||||
|
@ -14,6 +15,7 @@
|
||||||
:pattern)
|
:pattern)
|
||||||
|
|
||||||
(require (except-in "actor.rkt" actor-system))
|
(require (except-in "actor.rkt" actor-system))
|
||||||
|
(require "entity-ref.rkt")
|
||||||
(require "syntax.rkt")
|
(require "syntax.rkt")
|
||||||
(require preserves)
|
(require preserves)
|
||||||
(require preserves-schema)
|
(require preserves-schema)
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
(delete-directory/files output-directory #:must-exist? #f)
|
(delete-directory/files output-directory #:must-exist? #f)
|
||||||
(parameterize ((schema-compiler-plugin-mode 'meta))
|
(parameterize ((schema-compiler-plugin-mode 'meta))
|
||||||
(batch-compile #:inputs (list (build-path syndicate-path "schemas/**.prs"))
|
(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
|
#:output-directory output-directory
|
||||||
#:plugins (list schema-compiler-plugin))))
|
#:plugins (list schema-compiler-plugin))))
|
||||||
|
|
||||||
|
|
|
@ -11,6 +11,7 @@
|
||||||
|
|
||||||
(require "main.rkt")
|
(require "main.rkt")
|
||||||
(require "engine.rkt")
|
(require "engine.rkt")
|
||||||
|
(require "rewrite.rkt")
|
||||||
(require "schemas/gen/protocol.rkt")
|
(require "schemas/gen/protocol.rkt")
|
||||||
(require (prefix-in sturdy: "schemas/gen/sturdy.rkt"))
|
(require (prefix-in sturdy: "schemas/gen/sturdy.rkt"))
|
||||||
|
|
||||||
|
|
|
@ -2,12 +2,14 @@
|
||||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||||
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||||
|
|
||||||
(provide run-rewrites)
|
(provide run-rewrites
|
||||||
|
attenuate-entity-ref)
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require racket/dict)
|
(require racket/dict)
|
||||||
(require preserves)
|
(require preserves)
|
||||||
|
|
||||||
|
(require "entity-ref.rkt")
|
||||||
(require "schemas/gen/sturdy.rkt")
|
(require "schemas/gen/sturdy.rkt")
|
||||||
|
|
||||||
(define (match-Pattern p v)
|
(define (match-Pattern p v)
|
||||||
|
@ -59,6 +61,9 @@
|
||||||
(define (instantiate-Template t bindings)
|
(define (instantiate-Template t bindings)
|
||||||
(let walk ((t t))
|
(let walk ((t t))
|
||||||
(match 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))
|
[(Template-TRef (TRef name))
|
||||||
(hash-ref bindings name (lambda () (error 'instantiate-Template "Missing binding: ~v" name)))]
|
(hash-ref bindings name (lambda () (error 'instantiate-Template "Missing binding: ~v" name)))]
|
||||||
[(Template-Lit (Lit v)) v]
|
[(Template-Lit (Lit v)) v]
|
||||||
|
@ -104,3 +109,10 @@
|
||||||
[(cons stage remaining) (match (examine-alternatives stage v)
|
[(cons stage remaining) (match (examine-alternatives stage v)
|
||||||
[(? void?) (void)]
|
[(? void?) (void)]
|
||||||
[rewritten (loop remaining rewritten)])])))
|
[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))))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
version 1 .
|
version 1 .
|
||||||
embeddedType Actor.Ref .
|
embeddedType EntityRef.Ref .
|
||||||
|
|
||||||
Observe = <Observe @pattern dataspace-patterns.Pattern @observer #!any>.
|
Observe = <Observe @pattern dataspace-patterns.Pattern @observer #!any>.
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
version 1 .
|
version 1 .
|
||||||
embeddedType Actor.Ref .
|
embeddedType EntityRef.Ref .
|
||||||
|
|
||||||
Resolve = <resolve @sturdyref sturdy.SturdyRef @observer #!#!any>.
|
Resolve = <resolve @sturdyref sturdy.SturdyRef @observer #!#!any>.
|
||||||
Bind = <bind @oid any @key bytes @target #!any>.
|
Bind = <bind @oid any @key bytes @target #!any>.
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
version 1 .
|
version 1 .
|
||||||
embeddedType Actor.Ref .
|
embeddedType EntityRef.Ref .
|
||||||
|
|
||||||
UserId = int .
|
UserId = int .
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
version 1 .
|
version 1 .
|
||||||
embeddedType Actor.Ref .
|
embeddedType EntityRef.Ref .
|
||||||
|
|
||||||
Present = <Present @username string>.
|
Present = <Present @username string>.
|
||||||
Says = <Says @who string @what string>.
|
Says = <Says @who string @what string>.
|
||||||
|
|
|
@ -36,7 +36,8 @@ PNot = <not @pattern Pattern>.
|
||||||
PCompound = <compound @ctor ConstructorSpec @members PCompoundMembers>.
|
PCompound = <compound @ctor ConstructorSpec @members PCompoundMembers>.
|
||||||
PCompoundMembers = { any: Pattern ...:... }.
|
PCompoundMembers = { any: Pattern ...:... }.
|
||||||
|
|
||||||
Template = TRef / Lit / TCompound .
|
Template = TAttenuate / TRef / Lit / TCompound .
|
||||||
|
TAttenuate = <attenuate @template Template @attenuation Attenuation>.
|
||||||
TRef = <ref @name symbol>.
|
TRef = <ref @name symbol>.
|
||||||
TCompound = <compound @ctor ConstructorSpec @members TCompoundMembers>.
|
TCompound = <compound @ctor ConstructorSpec @members TCompoundMembers>.
|
||||||
TCompoundMembers = { any: Template ...:... }.
|
TCompoundMembers = { any: Template ...:... }.
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
version 1 .
|
version 1 .
|
||||||
embeddedType Actor.Ref .
|
embeddedType EntityRef.Ref .
|
||||||
|
|
||||||
Instance = <Instance @name string @argument any>.
|
Instance = <Instance @name string @argument any>.
|
||||||
|
|
Loading…
Reference in New Issue