Add visibility-restriction, making the test pass
This commit is contained in:
parent
9e923e1c63
commit
759bbdf1c3
|
@ -35,12 +35,12 @@
|
||||||
(on (message (broker-packet address (Ping)))
|
(on (message (broker-packet address (Ping)))
|
||||||
(w (Pong)))
|
(w (Pong)))
|
||||||
|
|
||||||
(during (observe (from-broker address $spec))
|
(during (observe ($ pat (from-broker address $spec)))
|
||||||
(define ep (next-ep))
|
(define ep (next-ep))
|
||||||
(on-start (w (Assert ep (observe spec))))
|
(on-start (w (Assert ep (observe spec))))
|
||||||
(on-stop (w (Clear ep)))
|
(on-stop (w (Clear ep)))
|
||||||
(on (message (broker-packet address (Add ep $vs)))
|
(on (message (broker-packet address (Add ep $vs)))
|
||||||
(react (assert (instantiate-term->value (from-broker address spec) vs))
|
(react (assert (instantiate-term->value pat vs))
|
||||||
(stop-when (message (broker-packet address (Del ep vs))))))
|
(stop-when (message (broker-packet address (Del ep vs))))))
|
||||||
(on (message (broker-packet address (Msg ep $vs)))
|
(on (message (broker-packet address (Msg ep $vs)))
|
||||||
(send! (instantiate-term->value (from-broker address spec) vs)))))
|
(send! (instantiate-term->value pat vs)))))
|
||||||
|
|
|
@ -81,7 +81,11 @@
|
||||||
x
|
x
|
||||||
(lambda (op . captured-values)
|
(lambda (op . captured-values)
|
||||||
(when (eq? op '+)
|
(when (eq? op '+)
|
||||||
(define term (instantiate-term->value pattern captured-values))
|
(define term
|
||||||
|
(instantiate-term->value pattern captured-values
|
||||||
|
#:visibility-restriction-proj #f))
|
||||||
|
;; TODO: flawed?? Needs visibility-restriction, or some other way
|
||||||
|
;; of ignoring the opaque placeholders!
|
||||||
(schedule-script!
|
(schedule-script!
|
||||||
(current-actor)
|
(current-actor)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
|
@ -77,34 +77,35 @@
|
||||||
(define outer-capture-proj (term->capture-proj x))
|
(define outer-capture-proj (term->capture-proj x))
|
||||||
(define inner-capture-proj (map (lambda (p) (cons 0 p)) outer-capture-proj))
|
(define inner-capture-proj (map (lambda (p) (cons 0 p)) outer-capture-proj))
|
||||||
;; ^ inner-capture-proj accounts for the extra (inbound ...) layer around assertions
|
;; ^ inner-capture-proj accounts for the extra (inbound ...) layer around assertions
|
||||||
(define i (term->skeleton-interest
|
(define i
|
||||||
x
|
(term->skeleton-interest
|
||||||
#:capture-projection outer-capture-proj
|
x
|
||||||
(lambda (op . captured-values)
|
#:capture-projection outer-capture-proj
|
||||||
(define term (inbound (instantiate-term->value x captured-values)))
|
(lambda (op . captured-values)
|
||||||
(define assertion (visibility-restriction inner-capture-proj term))
|
(define assertion
|
||||||
;; (log-info "~a => ~a ~a ~v"
|
(instantiate-term->value (inbound x) captured-values
|
||||||
;; outer-facet
|
#:visibility-restriction-proj inner-capture-proj))
|
||||||
;; inner-facet
|
;; (log-info "~a => ~a ~a ~v"
|
||||||
;; op
|
;; outer-facet
|
||||||
;; assertion)
|
;; inner-facet
|
||||||
(match op
|
;; op
|
||||||
['+ (apply-patch! inner-ds inner-actor (bag assertion +1))]
|
;; assertion)
|
||||||
['- (apply-patch! inner-ds inner-actor (bag assertion -1))]
|
(match op
|
||||||
['! (send-assertion! (dataspace-routing-table inner-ds) assertion)])
|
['+ (apply-patch! inner-ds inner-actor (bag assertion +1))]
|
||||||
(schedule-inner!))
|
['- (apply-patch! inner-ds inner-actor (bag assertion -1))]
|
||||||
#:cleanup
|
['! (send-assertion! (dataspace-routing-table inner-ds) assertion)])
|
||||||
(lambda (cache)
|
(schedule-inner!))
|
||||||
(apply-patch!
|
#:cleanup
|
||||||
inner-ds
|
(lambda (cache)
|
||||||
inner-actor
|
(apply-patch!
|
||||||
(for/bag/count [(captured-values (in-bag cache))]
|
inner-ds
|
||||||
;; (log-info "~a (cleanup) ~v" inner-actor term)
|
inner-actor
|
||||||
(values (visibility-restriction
|
(for/bag/count [(captured-values (in-bag cache))]
|
||||||
inner-capture-proj
|
;; (log-info "~a (cleanup) ~v" inner-actor term)
|
||||||
(inbound (instantiate-term->value x captured-values)))
|
(values (instantiate-term->value (inbound x) captured-values
|
||||||
-1)))
|
#:visibility-restriction-proj inner-capture-proj)
|
||||||
(schedule-inner!))))
|
-1)))
|
||||||
|
(schedule-inner!))))
|
||||||
(add-endpoint-if-live! outer-facet
|
(add-endpoint-if-live! outer-facet
|
||||||
inbound-endpoints
|
inbound-endpoints
|
||||||
x
|
x
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
|
|
||||||
;; A VisibilityRestriction describes ... TODO
|
;; A VisibilityRestriction describes ... TODO
|
||||||
;; (visibility-restriction SkProj Assertion)
|
;; (visibility-restriction SkProj Assertion)
|
||||||
(struct visibility-restriction (path term) #:transparent)
|
(struct visibility-restriction (proj term) #:transparent)
|
||||||
|
|
||||||
;; A ScopedAssertion is a VisibilityRestriction or an Assertion.
|
;; A ScopedAssertion is a VisibilityRestriction or an Assertion.
|
||||||
;; (Corollary: Instances of `visibility-restriction` can never be assertions.)
|
;; (Corollary: Instances of `visibility-restriction` can never be assertions.)
|
||||||
|
|
|
@ -93,7 +93,8 @@
|
||||||
;; otherwise-potentially-matching constant positions in instantiated
|
;; otherwise-potentially-matching constant positions in instantiated
|
||||||
;; terms
|
;; terms
|
||||||
|
|
||||||
(define (instantiate-term->value t actuals)
|
(define (instantiate-term->value t actuals
|
||||||
|
#:visibility-restriction-proj [vrproj (term->capture-proj t)])
|
||||||
(define (pop-actual!)
|
(define (pop-actual!)
|
||||||
(define v (car actuals))
|
(define v (car actuals))
|
||||||
(set! actuals (cdr actuals))
|
(set! actuals (cdr actuals))
|
||||||
|
@ -129,7 +130,9 @@
|
||||||
(for/vector [(tt t)] (walk tt))]
|
(for/vector [(tt t)] (walk tt))]
|
||||||
[other other]))
|
[other other]))
|
||||||
|
|
||||||
(walk t))
|
(if vrproj
|
||||||
|
(visibility-restriction vrproj (walk t))
|
||||||
|
(walk t)))
|
||||||
|
|
||||||
;; Omits captures.
|
;; Omits captures.
|
||||||
(define (term-intersect t1 t2 ks kf)
|
(define (term-intersect t1 t2 ks kf)
|
||||||
|
|
Loading…
Reference in New Issue