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
|
||||
|
||||
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
|
||||
model of Conversational Concurrency [is great], but implementing it
|
||||
|
@ -310,14 +310,17 @@ cases where handlers are dynamically installed.
|
|||
let (_, root) = index
|
||||
let (cache, table) = extend root s
|
||||
let constLocs = [h | (h,v) ∈ constantMap]
|
||||
let constVals = [v | (h,v) ∈ constantMap]
|
||||
if constLocs not in table then
|
||||
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
|
||||
let leafcache =
|
||||
{ v | v ∈ cache,
|
||||
projectMany v constLocs = constVals }
|
||||
table[constLocs][constVals] := (leafcache, {})
|
||||
table[constLocs][constVals] := ({}, {})
|
||||
let (leafcache, leaftable) = table[constLocs][constVals]
|
||||
if captureMap not in leaftable then
|
||||
let bag = empty_bag
|
||||
|
@ -343,9 +346,9 @@ cases where handlers are dynamically installed.
|
|||
let (_, root) = index
|
||||
let (cache, table) = extend root s
|
||||
let constLocs = [h | (h,v) ∈ constantMap]
|
||||
let constVals = [v | (h,v) ∈ constantMap]
|
||||
if constLocs not in table then
|
||||
return
|
||||
let constVals = [v | (h,v) ∈ constantMap]
|
||||
if constVals not in table[constLocs] then
|
||||
return
|
||||
let (leafcache, leaftable) = table[constLocs][constVals]
|
||||
|
@ -357,7 +360,7 @@ cases where handlers are dynamically installed.
|
|||
f_table -= f
|
||||
if f_table = {} then
|
||||
delete leaftable[captureMap]
|
||||
if leaftable = {} then
|
||||
if leafcache = {} and leaftable = {} then
|
||||
delete table[constLocs][constVals]
|
||||
if table[constLocs] = {} then
|
||||
delete table[constLocs]
|
||||
|
@ -373,13 +376,16 @@ parameterized with different update procedures.
|
|||
by side-effect; in particular, the `m_handler` procedure may choose
|
||||
to invoke the callback passed to it.
|
||||
|
||||
Operation = { AddAssertion, RemoveAssertion, SendMessage }
|
||||
|
||||
modify :: Node ->
|
||||
Operation ->
|
||||
V ->
|
||||
(Continuation -> V -> 1) ->
|
||||
(Leaf -> V -> 1) ->
|
||||
(Handler -> [V] -> 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)]
|
||||
where
|
||||
walk-node :: Node -> [V] -> 1
|
||||
|
@ -397,6 +403,8 @@ parameterized with different update procedures.
|
|||
m_cont cont v
|
||||
for constLocs in table
|
||||
let consts = projectMany v constLocs
|
||||
if operation = AddAssertion and consts not in table[constLocs] then
|
||||
table[constLocs][consts] := ({}, {})
|
||||
if consts in table[constLocs] then
|
||||
let leaf@(leafcache, leaftable) =
|
||||
table[constLocs][consts]
|
||||
|
@ -405,6 +413,10 @@ parameterized with different update procedures.
|
|||
let handler = leaftable[captureMap]
|
||||
let vs = projectMany v captureMap
|
||||
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
|
||||
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
|
||||
let is_present = v in cache
|
||||
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
|
||||
modify root v del_cont del_leaf del_handler
|
||||
modify root RemoveAssertion v del_cont del_leaf del_handler
|
||||
where
|
||||
add_cont (cache, _) v = cache += v
|
||||
add_leaf (leafcache, _) v = leafcache += v
|
||||
|
@ -472,7 +484,7 @@ processed first, no glitch will be detected.
|
|||
|
||||
sendMessage :: Index -> V -> 1
|
||||
sendMessage (_, root) v =
|
||||
modify root v send_cont send_leaf send_handler
|
||||
modify root SendMessage v send_cont send_leaf send_handler
|
||||
where
|
||||
send_cont _ _ = ()
|
||||
send_leaf _ _ = ()
|
||||
|
|
|
@ -122,17 +122,21 @@
|
|||
(define (make-empty-skeleton)
|
||||
(make-empty-skeleton/cache (make-hash)))
|
||||
|
||||
(define (make-empty-matched-constant)
|
||||
(skeleton-matched-constant (make-hash) (make-hash)))
|
||||
|
||||
(define (skcont-add! c i)
|
||||
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
|
||||
(define (make-matched-constant)
|
||||
(define assertions (make-hash))
|
||||
(define (classify-assertions)
|
||||
(define cvt (make-hash))
|
||||
(hash-for-each (skeleton-continuation-cache c)
|
||||
(lambda (a _)
|
||||
(when (equal? (apply-projection (unscope-assertion a) cs) cv)
|
||||
(hash-set! assertions a #t))))
|
||||
(skeleton-matched-constant assertions (make-hash)))
|
||||
(define cvt (hash-ref! (skeleton-continuation-table c) cs make-hash))
|
||||
(define sc (hash-ref! cvt cv make-matched-constant))
|
||||
(define avs (apply-projection (unscope-assertion a) cs))
|
||||
(define sc (hash-ref! cvt avs make-empty-matched-constant))
|
||||
(hash-set! (skeleton-matched-constant-cache sc) a #t)))
|
||||
cvt)
|
||||
(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 cache (make-bag))
|
||||
(hash-for-each (skeleton-matched-constant-cache sc)
|
||||
|
@ -145,6 +149,10 @@
|
|||
(hash-set! (skeleton-accumulator-handlers acc) h #t)
|
||||
(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)
|
||||
(match-define (skeleton-interest _desc cs cv vs h cleanup) i)
|
||||
(define cvt (hash-ref (skeleton-continuation-table c) cs #f))
|
||||
|
@ -158,7 +166,7 @@
|
|||
(hash-remove! (skeleton-accumulator-handlers acc) h)
|
||||
(when (hash-empty? (skeleton-accumulator-handlers acc))
|
||||
(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)))
|
||||
(when (hash-empty? cvt)
|
||||
(hash-remove! (skeleton-continuation-table c) cs))))
|
||||
|
@ -259,29 +267,36 @@
|
|||
(let ((sk (extend-skeleton! sk (skeleton-interest-desc 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)
|
||||
|
||||
(define (walk-node! sk term-stack)
|
||||
(match-define (skeleton-node continuation edges) sk)
|
||||
|
||||
(modify-skcont! continuation term0)
|
||||
(hash-for-each (skeleton-continuation-table continuation)
|
||||
(let ((sct (skeleton-continuation-table continuation))
|
||||
(constant-projections-to-remove '()))
|
||||
(hash-for-each sct
|
||||
(lambda (constant-proj key-proj-handler)
|
||||
(define constants (apply-projection term0-term constant-proj))
|
||||
(define proj-handler (hash-ref key-proj-handler constants #f))
|
||||
(define proj-handler
|
||||
(hash-ref key-proj-handler
|
||||
constants
|
||||
(lambda () (on-missing-skconst key-proj-handler constants))))
|
||||
(when proj-handler
|
||||
(modify-skconst! proj-handler term0)
|
||||
(when (eq? (modify-skconst! proj-handler term0) 'remove-check)
|
||||
(when (skeleton-matched-constant-empty? proj-handler)
|
||||
(hash-remove! key-proj-handler constants)
|
||||
(when (hash-empty? key-proj-handler)
|
||||
(set! constant-projections-to-remove
|
||||
(cons constant-proj constant-projections-to-remove)))))
|
||||
(hash-for-each (skeleton-matched-constant-table proj-handler)
|
||||
(lambda (variable-proj acc)
|
||||
;; (when restriction-path
|
||||
;; (log-info "Restriction path ~v in effect; variable-proj is ~v, and term is ~v"
|
||||
;; restriction-path
|
||||
;; variable-proj
|
||||
;; term0))
|
||||
(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))]
|
||||
(match-define (cons (skeleton-selector pop-count index) table) edge)
|
||||
|
@ -321,13 +336,18 @@
|
|||
(skeleton-modify! sk
|
||||
term
|
||||
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-skacc!))
|
||||
|
||||
(define (remove-term-from-skcont! skcont term)
|
||||
(hash-remove! (skeleton-continuation-cache skcont) 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 cache (skeleton-accumulator-cache skacc))
|
||||
;; (log-info ">>>>>> At removal time for ~v, cache has ~v" _term (hash-ref cache vars 0))
|
||||
|
@ -345,6 +365,7 @@
|
|||
(skeleton-modify! sk
|
||||
term
|
||||
remove-term-from-skcont!
|
||||
(lambda (_cv-table _cv) #f)
|
||||
remove-term-from-skconst!
|
||||
remove-term-from-skacc!))
|
||||
|
||||
|
@ -352,6 +373,7 @@
|
|||
(skeleton-modify! sk
|
||||
term
|
||||
void
|
||||
(lambda (_cv-table _cv) #f)
|
||||
void
|
||||
(lambda (skacc vars _term)
|
||||
(hash-for-each (skeleton-accumulator-handlers skacc)
|
||||
|
|
Loading…
Reference in New Issue