Cope with echo-server minimart-benchmark test: flat new-connection cost

This commit is contained in:
Tony Garnock-Jones 2019-06-21 16:43:59 +01:00
parent df6918bc6f
commit 976741cd49
2 changed files with 72 additions and 38 deletions

View File

@ -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 _ _ = ()

View File

@ -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)