Cope with echo-server minimart-benchmark test: flat new-connection cost
This commit is contained in:
parent
df6918bc6f
commit
976741cd49
|
@ -1,7 +1,7 @@
|
||||||
# Efficient, Imperative Dataspaces for Conversational Concurrency
|
# Efficient, Imperative Dataspaces for Conversational Concurrency
|
||||||
|
|
||||||
Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||||
20 October 2018
|
20 October 2018; revised 21 June 2019
|
||||||
|
|
||||||
<p style="font-size:90%"><strong>Abstract.</strong> The dataspace
|
<p style="font-size:90%"><strong>Abstract.</strong> The dataspace
|
||||||
model of Conversational Concurrency [is great], but implementing it
|
model of Conversational Concurrency [is great], but implementing it
|
||||||
|
@ -310,14 +310,17 @@ cases where handlers are dynamically installed.
|
||||||
let (_, root) = index
|
let (_, root) = index
|
||||||
let (cache, table) = extend root s
|
let (cache, table) = extend root s
|
||||||
let constLocs = [h | (h,v) ∈ constantMap]
|
let constLocs = [h | (h,v) ∈ constantMap]
|
||||||
let constVals = [v | (h,v) ∈ constantMap]
|
|
||||||
if constLocs not in table then
|
if constLocs not in table then
|
||||||
table[constLocs] := {}
|
table[constLocs] := {}
|
||||||
|
for v in cache
|
||||||
|
let key = projectMany v constLocs
|
||||||
|
if key not in table[constLocs] then
|
||||||
|
table[constLocs][key] := ({}, {})
|
||||||
|
let (leafcache, _leaftable) = table[constLocs][key]
|
||||||
|
leafcache += v
|
||||||
|
let constVals = [v | (h,v) ∈ constantMap]
|
||||||
if constVals not in table[constLocs] then
|
if constVals not in table[constLocs] then
|
||||||
let leafcache =
|
table[constLocs][constVals] := ({}, {})
|
||||||
{ v | v ∈ cache,
|
|
||||||
projectMany v constLocs = constVals }
|
|
||||||
table[constLocs][constVals] := (leafcache, {})
|
|
||||||
let (leafcache, leaftable) = table[constLocs][constVals]
|
let (leafcache, leaftable) = table[constLocs][constVals]
|
||||||
if captureMap not in leaftable then
|
if captureMap not in leaftable then
|
||||||
let bag = empty_bag
|
let bag = empty_bag
|
||||||
|
@ -343,9 +346,9 @@ cases where handlers are dynamically installed.
|
||||||
let (_, root) = index
|
let (_, root) = index
|
||||||
let (cache, table) = extend root s
|
let (cache, table) = extend root s
|
||||||
let constLocs = [h | (h,v) ∈ constantMap]
|
let constLocs = [h | (h,v) ∈ constantMap]
|
||||||
let constVals = [v | (h,v) ∈ constantMap]
|
|
||||||
if constLocs not in table then
|
if constLocs not in table then
|
||||||
return
|
return
|
||||||
|
let constVals = [v | (h,v) ∈ constantMap]
|
||||||
if constVals not in table[constLocs] then
|
if constVals not in table[constLocs] then
|
||||||
return
|
return
|
||||||
let (leafcache, leaftable) = table[constLocs][constVals]
|
let (leafcache, leaftable) = table[constLocs][constVals]
|
||||||
|
@ -357,7 +360,7 @@ cases where handlers are dynamically installed.
|
||||||
f_table -= f
|
f_table -= f
|
||||||
if f_table = {} then
|
if f_table = {} then
|
||||||
delete leaftable[captureMap]
|
delete leaftable[captureMap]
|
||||||
if leaftable = {} then
|
if leafcache = {} and leaftable = {} then
|
||||||
delete table[constLocs][constVals]
|
delete table[constLocs][constVals]
|
||||||
if table[constLocs] = {} then
|
if table[constLocs] = {} then
|
||||||
delete table[constLocs]
|
delete table[constLocs]
|
||||||
|
@ -373,13 +376,16 @@ parameterized with different update procedures.
|
||||||
by side-effect; in particular, the `m_handler` procedure may choose
|
by side-effect; in particular, the `m_handler` procedure may choose
|
||||||
to invoke the callback passed to it.
|
to invoke the callback passed to it.
|
||||||
|
|
||||||
|
Operation = { AddAssertion, RemoveAssertion, SendMessage }
|
||||||
|
|
||||||
modify :: Node ->
|
modify :: Node ->
|
||||||
|
Operation ->
|
||||||
V ->
|
V ->
|
||||||
(Continuation -> V -> 1) ->
|
(Continuation -> V -> 1) ->
|
||||||
(Leaf -> V -> 1) ->
|
(Leaf -> V -> 1) ->
|
||||||
(Handler -> [V] -> 1) ->
|
(Handler -> [V] -> 1) ->
|
||||||
1
|
1
|
||||||
modify node v m_cont m_leaf m_handler =
|
modify node operation v m_cont m_leaf m_handler =
|
||||||
walk-node node [outermost(v)]
|
walk-node node [outermost(v)]
|
||||||
where
|
where
|
||||||
walk-node :: Node -> [V] -> 1
|
walk-node :: Node -> [V] -> 1
|
||||||
|
@ -397,6 +403,8 @@ parameterized with different update procedures.
|
||||||
m_cont cont v
|
m_cont cont v
|
||||||
for constLocs in table
|
for constLocs in table
|
||||||
let consts = projectMany v constLocs
|
let consts = projectMany v constLocs
|
||||||
|
if operation = AddAssertion and consts not in table[constLocs] then
|
||||||
|
table[constLocs][consts] := ({}, {})
|
||||||
if consts in table[constLocs] then
|
if consts in table[constLocs] then
|
||||||
let leaf@(leafcache, leaftable) =
|
let leaf@(leafcache, leaftable) =
|
||||||
table[constLocs][consts]
|
table[constLocs][consts]
|
||||||
|
@ -405,6 +413,10 @@ parameterized with different update procedures.
|
||||||
let handler = leaftable[captureMap]
|
let handler = leaftable[captureMap]
|
||||||
let vs = projectMany v captureMap
|
let vs = projectMany v captureMap
|
||||||
m_handler handler vs
|
m_handler handler vs
|
||||||
|
if operation = RemoveAssertion and leafcache = {} and leaftable = {} then
|
||||||
|
delete table[constLocs][consts]
|
||||||
|
if table[constLocs] = {} then
|
||||||
|
delete table[constLocs]
|
||||||
|
|
||||||
The `outermost` constructor applied to `v` at the top of `modify` is
|
The `outermost` constructor applied to `v` at the top of `modify` is
|
||||||
necessary because every path in the trie structure embodied in each
|
necessary because every path in the trie structure embodied in each
|
||||||
|
@ -427,9 +439,9 @@ check followed by zero or more (move, check) pairs.
|
||||||
cache[v] += delta
|
cache[v] += delta
|
||||||
let is_present = v in cache
|
let is_present = v in cache
|
||||||
if not was_present and is_present then
|
if not was_present and is_present then
|
||||||
modify root v add_cont add_leaf add_handler
|
modify root AddAssertion v add_cont add_leaf add_handler
|
||||||
if was_present and not is_present then
|
if was_present and not is_present then
|
||||||
modify root v del_cont del_leaf del_handler
|
modify root RemoveAssertion v del_cont del_leaf del_handler
|
||||||
where
|
where
|
||||||
add_cont (cache, _) v = cache += v
|
add_cont (cache, _) v = cache += v
|
||||||
add_leaf (leafcache, _) v = leafcache += v
|
add_leaf (leafcache, _) v = leafcache += v
|
||||||
|
@ -472,7 +484,7 @@ processed first, no glitch will be detected.
|
||||||
|
|
||||||
sendMessage :: Index -> V -> 1
|
sendMessage :: Index -> V -> 1
|
||||||
sendMessage (_, root) v =
|
sendMessage (_, root) v =
|
||||||
modify root v send_cont send_leaf send_handler
|
modify root SendMessage v send_cont send_leaf send_handler
|
||||||
where
|
where
|
||||||
send_cont _ _ = ()
|
send_cont _ _ = ()
|
||||||
send_leaf _ _ = ()
|
send_leaf _ _ = ()
|
||||||
|
|
|
@ -122,17 +122,21 @@
|
||||||
(define (make-empty-skeleton)
|
(define (make-empty-skeleton)
|
||||||
(make-empty-skeleton/cache (make-hash)))
|
(make-empty-skeleton/cache (make-hash)))
|
||||||
|
|
||||||
|
(define (make-empty-matched-constant)
|
||||||
|
(skeleton-matched-constant (make-hash) (make-hash)))
|
||||||
|
|
||||||
(define (skcont-add! c i)
|
(define (skcont-add! c i)
|
||||||
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
|
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
|
||||||
(define (make-matched-constant)
|
(define (classify-assertions)
|
||||||
(define assertions (make-hash))
|
(define cvt (make-hash))
|
||||||
(hash-for-each (skeleton-continuation-cache c)
|
(hash-for-each (skeleton-continuation-cache c)
|
||||||
(lambda (a _)
|
(lambda (a _)
|
||||||
(when (equal? (apply-projection (unscope-assertion a) cs) cv)
|
(define avs (apply-projection (unscope-assertion a) cs))
|
||||||
(hash-set! assertions a #t))))
|
(define sc (hash-ref! cvt avs make-empty-matched-constant))
|
||||||
(skeleton-matched-constant assertions (make-hash)))
|
(hash-set! (skeleton-matched-constant-cache sc) a #t)))
|
||||||
(define cvt (hash-ref! (skeleton-continuation-table c) cs make-hash))
|
cvt)
|
||||||
(define sc (hash-ref! cvt cv make-matched-constant))
|
(define cvt (hash-ref! (skeleton-continuation-table c) cs classify-assertions))
|
||||||
|
(define sc (hash-ref! cvt cv make-empty-matched-constant))
|
||||||
(define (make-accumulator)
|
(define (make-accumulator)
|
||||||
(define cache (make-bag))
|
(define cache (make-bag))
|
||||||
(hash-for-each (skeleton-matched-constant-cache sc)
|
(hash-for-each (skeleton-matched-constant-cache sc)
|
||||||
|
@ -145,6 +149,10 @@
|
||||||
(hash-set! (skeleton-accumulator-handlers acc) h #t)
|
(hash-set! (skeleton-accumulator-handlers acc) h #t)
|
||||||
(for [(vars (in-bag (skeleton-accumulator-cache acc)))] (apply h '+ vars)))
|
(for [(vars (in-bag (skeleton-accumulator-cache acc)))] (apply h '+ vars)))
|
||||||
|
|
||||||
|
(define (skeleton-matched-constant-empty? sc)
|
||||||
|
(match-define (skeleton-matched-constant cache table) sc)
|
||||||
|
(and (hash-empty? cache) (hash-empty? table)))
|
||||||
|
|
||||||
(define (skcont-remove! c i)
|
(define (skcont-remove! c i)
|
||||||
(match-define (skeleton-interest _desc cs cv vs h cleanup) i)
|
(match-define (skeleton-interest _desc cs cv vs h cleanup) i)
|
||||||
(define cvt (hash-ref (skeleton-continuation-table c) cs #f))
|
(define cvt (hash-ref (skeleton-continuation-table c) cs #f))
|
||||||
|
@ -158,7 +166,7 @@
|
||||||
(hash-remove! (skeleton-accumulator-handlers acc) h)
|
(hash-remove! (skeleton-accumulator-handlers acc) h)
|
||||||
(when (hash-empty? (skeleton-accumulator-handlers acc))
|
(when (hash-empty? (skeleton-accumulator-handlers acc))
|
||||||
(hash-remove! (skeleton-matched-constant-table sc) vs)))
|
(hash-remove! (skeleton-matched-constant-table sc) vs)))
|
||||||
(when (hash-empty? (skeleton-matched-constant-table sc))
|
(when (skeleton-matched-constant-empty? sc)
|
||||||
(hash-remove! cvt cv)))
|
(hash-remove! cvt cv)))
|
||||||
(when (hash-empty? cvt)
|
(when (hash-empty? cvt)
|
||||||
(hash-remove! (skeleton-continuation-table c) cs))))
|
(hash-remove! (skeleton-continuation-table c) cs))))
|
||||||
|
@ -259,29 +267,36 @@
|
||||||
(let ((sk (extend-skeleton! sk (skeleton-interest-desc i))))
|
(let ((sk (extend-skeleton! sk (skeleton-interest-desc i))))
|
||||||
(skcont-remove! (skeleton-node-continuation sk) i)))
|
(skcont-remove! (skeleton-node-continuation sk) i)))
|
||||||
|
|
||||||
(define (skeleton-modify! sk term0 modify-skcont! modify-skconst! modify-skacc!)
|
(define (skeleton-modify! sk term0 modify-skcont! on-missing-skconst modify-skconst! modify-skacc!)
|
||||||
(unpack-scoped-assertion [restriction-path term0-term] term0)
|
(unpack-scoped-assertion [restriction-path term0-term] term0)
|
||||||
|
|
||||||
(define (walk-node! sk term-stack)
|
(define (walk-node! sk term-stack)
|
||||||
(match-define (skeleton-node continuation edges) sk)
|
(match-define (skeleton-node continuation edges) sk)
|
||||||
|
|
||||||
(modify-skcont! continuation term0)
|
(modify-skcont! continuation term0)
|
||||||
(hash-for-each (skeleton-continuation-table continuation)
|
(let ((sct (skeleton-continuation-table continuation))
|
||||||
(lambda (constant-proj key-proj-handler)
|
(constant-projections-to-remove '()))
|
||||||
(define constants (apply-projection term0-term constant-proj))
|
(hash-for-each sct
|
||||||
(define proj-handler (hash-ref key-proj-handler constants #f))
|
(lambda (constant-proj key-proj-handler)
|
||||||
(when proj-handler
|
(define constants (apply-projection term0-term constant-proj))
|
||||||
(modify-skconst! proj-handler term0)
|
(define proj-handler
|
||||||
(hash-for-each (skeleton-matched-constant-table proj-handler)
|
(hash-ref key-proj-handler
|
||||||
(lambda (variable-proj acc)
|
constants
|
||||||
;; (when restriction-path
|
(lambda () (on-missing-skconst key-proj-handler constants))))
|
||||||
;; (log-info "Restriction path ~v in effect; variable-proj is ~v, and term is ~v"
|
(when proj-handler
|
||||||
;; restriction-path
|
(when (eq? (modify-skconst! proj-handler term0) 'remove-check)
|
||||||
;; variable-proj
|
(when (skeleton-matched-constant-empty? proj-handler)
|
||||||
;; term0))
|
(hash-remove! key-proj-handler constants)
|
||||||
(when (unrestricted? variable-proj restriction-path)
|
(when (hash-empty? key-proj-handler)
|
||||||
(define vars (apply-projection term0-term variable-proj))
|
(set! constant-projections-to-remove
|
||||||
(modify-skacc! acc vars term0)))))))
|
(cons constant-proj constant-projections-to-remove)))))
|
||||||
|
(hash-for-each (skeleton-matched-constant-table proj-handler)
|
||||||
|
(lambda (variable-proj acc)
|
||||||
|
(when (unrestricted? variable-proj restriction-path)
|
||||||
|
(define vars (apply-projection term0-term variable-proj))
|
||||||
|
(modify-skacc! acc vars term0)))))))
|
||||||
|
(for-each (lambda (constant-proj) (hash-remove! sct constant-proj))
|
||||||
|
constant-projections-to-remove))
|
||||||
|
|
||||||
(for [(edge (in-list edges))]
|
(for [(edge (in-list edges))]
|
||||||
(match-define (cons (skeleton-selector pop-count index) table) edge)
|
(match-define (cons (skeleton-selector pop-count index) table) edge)
|
||||||
|
@ -321,13 +336,18 @@
|
||||||
(skeleton-modify! sk
|
(skeleton-modify! sk
|
||||||
term
|
term
|
||||||
add-term-to-skcont!
|
add-term-to-skcont!
|
||||||
|
(lambda (cv-table cv)
|
||||||
|
(let ((sc (make-empty-matched-constant)))
|
||||||
|
(hash-set! cv-table cv sc)
|
||||||
|
sc))
|
||||||
add-term-to-skconst!
|
add-term-to-skconst!
|
||||||
add-term-to-skacc!))
|
add-term-to-skacc!))
|
||||||
|
|
||||||
(define (remove-term-from-skcont! skcont term)
|
(define (remove-term-from-skcont! skcont term)
|
||||||
(hash-remove! (skeleton-continuation-cache skcont) term))
|
(hash-remove! (skeleton-continuation-cache skcont) term))
|
||||||
(define (remove-term-from-skconst! skconst term)
|
(define (remove-term-from-skconst! skconst term)
|
||||||
(hash-remove! (skeleton-matched-constant-cache skconst) term))
|
(hash-remove! (skeleton-matched-constant-cache skconst) term)
|
||||||
|
'remove-check)
|
||||||
(define (remove-term-from-skacc! skacc vars _term)
|
(define (remove-term-from-skacc! skacc vars _term)
|
||||||
(define cache (skeleton-accumulator-cache skacc))
|
(define cache (skeleton-accumulator-cache skacc))
|
||||||
;; (log-info ">>>>>> At removal time for ~v, cache has ~v" _term (hash-ref cache vars 0))
|
;; (log-info ">>>>>> At removal time for ~v, cache has ~v" _term (hash-ref cache vars 0))
|
||||||
|
@ -345,6 +365,7 @@
|
||||||
(skeleton-modify! sk
|
(skeleton-modify! sk
|
||||||
term
|
term
|
||||||
remove-term-from-skcont!
|
remove-term-from-skcont!
|
||||||
|
(lambda (_cv-table _cv) #f)
|
||||||
remove-term-from-skconst!
|
remove-term-from-skconst!
|
||||||
remove-term-from-skacc!))
|
remove-term-from-skacc!))
|
||||||
|
|
||||||
|
@ -352,6 +373,7 @@
|
||||||
(skeleton-modify! sk
|
(skeleton-modify! sk
|
||||||
term
|
term
|
||||||
void
|
void
|
||||||
|
(lambda (_cv-table _cv) #f)
|
||||||
void
|
void
|
||||||
(lambda (skacc vars _term)
|
(lambda (skacc vars _term)
|
||||||
(hash-for-each (skeleton-accumulator-handlers skacc)
|
(hash-for-each (skeleton-accumulator-handlers skacc)
|
||||||
|
|
Loading…
Reference in New Issue