syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Gestalts massively simplify demand-matcher

This commit is contained in:
Tony Garnock-Jones 2014-05-21 23:21:39 -04:00
parent d37eaa1236
commit d86c64f68a
2 changed files with 34 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
minimart/demand-matcher.rkt
View File

@ -1,8 +1,9 @@
#lang racket/base #lang racket/base
(require racket/set)
(require racket/match) (require racket/match)
(require "core.rkt") (require "core.rkt")
(require "presence-detector.rkt") (require "gestalt.rkt")
(provide (except-out (struct-out demand-matcher) demand-matcher) (provide (except-out (struct-out demand-matcher) demand-matcher)
(rename-out [make-demand-matcher demand-matcher]) (rename-out [make-demand-matcher demand-matcher])
@ -11,100 +12,61 @@
(struct demand-matcher (demand-is-subscription? (struct demand-matcher (demand-is-subscription?
pattern pattern
spec
meta-level meta-level
demand-level demand-level
supply-level supply-level
increase-handler increase-handler
decrease-handler decrease-handler
state) current-demand
current-supply)
#:transparent) #:transparent)
(define (unexpected-supply-decrease r) (define (unexpected-supply-decrease . removed-captures)
'()) '())
(define (default-decrease-handler removed state) (define (default-decrease-handler state . removed-captures)
state) state)
(define (make-demand-matcher demand-is-subscription? (define (make-demand-matcher demand-is-subscription?
pattern projection
meta-level meta-level
demand-level demand-level
supply-level supply-level
increase-handler increase-handler
[decrease-handler default-decrease-handler]) [decrease-handler default-decrease-handler])
(demand-matcher demand-is-subscription? (demand-matcher demand-is-subscription?
pattern (projection->pattern projection)
(compile-gestalt-projection projection)
meta-level meta-level
demand-level demand-level
supply-level supply-level
increase-handler increase-handler
decrease-handler decrease-handler
(presence-detector))) (set)
(set)))
(define (compute-detector demand? d) (define (demand-matcher-update d s g)
(route (if (demand-matcher-demand-is-subscription? d) (not demand?) demand?) (match-define (demand-matcher demand-is-sub? _ spec ml dl sl inc-h dec-h old-demand old-supply) d)
(demand-matcher-pattern d) (define new-demand (matcher-key-set (gestalt-project g ml dl (not demand-is-sub?) spec)))
(demand-matcher-meta-level d) (define new-supply (matcher-key-set (gestalt-project g ml sl demand-is-sub? spec)))
(+ 1 (max (demand-matcher-demand-level d) (define demand+ (set-subtract (set-subtract new-demand old-demand) new-supply))
(demand-matcher-supply-level d))))) (define supply- (set-intersect (set-subtract old-supply new-supply) new-demand))
(define new-d (struct-copy demand-matcher d
;; For each route "changed" in routes, if changed is one of our [current-demand new-demand]
;; monitored entities (a demand, if arrivals? is #t, or a supply [current-supply new-supply]))
;; otherwise), including both a pattern, meta-level, and level match, (let* ((s (for/fold [(s s)] [(k (in-set demand+))] (apply inc-h s (vector->list k))))
;; then search for matching peers (including level matching). If (s (for/fold [(s s)] [(k (in-set supply-))] (apply dec-h s (vector->list k)))))
;; arrivals? is #t, then if there are no matching peers (i.e. supplies (values new-d s)))
;; are not allocated), signel an increas in demand; otherwise, if
;; there are any matching peers (i.e. demand remains), signal a
;; decrease in supply.
(define (incorporate-delta arrivals? routes d state)
(define relevant-change-detector (compute-detector arrivals? d))
(define expected-change-level
(if arrivals? (demand-matcher-demand-level d) (demand-matcher-supply-level d)))
(define expected-peer-level
(if arrivals? (demand-matcher-supply-level d) (demand-matcher-demand-level d)))
(for/fold ([s state]) ([changed routes])
(if (= (route-level changed) expected-change-level)
(match (intersect-routes (list changed) (list relevant-change-detector))
['() s]
[(list relevant-changed-route) ;; narrowed to relevancy by intersect-routes
;; (log-info "incorporate-delta ~v ~v <--> ~v /// ~v"
;; arrivals?
;; relevant-changed-route
;; relevant-change-detector
;; (demand-matcher-state d))
(define peer-detector
(struct-copy route relevant-changed-route [level (+ 1 expected-peer-level)]))
(define peer-exists?
(ormap (lambda (r) (= (route-level r) expected-peer-level))
(intersect-routes (presence-detector-routes (demand-matcher-state d))
(list peer-detector))))
;; (log-info "peer-exists? == ~v, peer-detector == ~v"
;; peer-exists?
;; peer-detector)
(cond
[(and arrivals? (not peer-exists?))
((demand-matcher-increase-handler d) relevant-changed-route s)]
[(and (not arrivals?) peer-exists?)
((demand-matcher-decrease-handler d) relevant-changed-route s)]
[else
s])])
s)))
(define (demand-matcher-update d state0 rs)
(define-values (new-state added removed) (presence-detector-update (demand-matcher-state d) rs))
(define new-d (struct-copy demand-matcher d [state new-state]))
(define state1 (incorporate-delta #t added new-d state0))
(define state2 (incorporate-delta #f removed new-d state1))
(values new-d state2))
(define (demand-matcher-handle-event e d) (define (demand-matcher-handle-event e d)
(match e (match e
[(routing-update routes) [(routing-update gestalt)
(define-values (new-d actions) (demand-matcher-update d '() routes)) (define-values (new-d actions) (demand-matcher-update d '() gestalt))
(transition new-d actions)] (transition new-d actions)]
[_ #f])) [_ #f]))
(define (spawn-demand-matcher pattern (define (spawn-demand-matcher projection
increase-handler increase-handler
[decrease-handler unexpected-supply-decrease] [decrease-handler unexpected-supply-decrease]
#:demand-is-subscription? [demand-is-subscription? #t] #:demand-is-subscription? [demand-is-subscription? #t]
@ -112,13 +74,15 @@
#:demand-level [demand-level 0] #:demand-level [demand-level 0]
#:supply-level [supply-level 0]) #:supply-level [supply-level 0])
(define d (make-demand-matcher demand-is-subscription? (define d (make-demand-matcher demand-is-subscription?
pattern projection
meta-level meta-level
demand-level demand-level
supply-level supply-level
(lambda (r actions) (cons (increase-handler r) actions)) (lambda (acs . rs) (cons (apply increase-handler rs) acs))
(lambda (r actions) (cons (decrease-handler r) actions)))) (lambda (acs . rs) (cons (apply decrease-handler rs) acs))))
(define observer-pattern (demand-matcher-pattern d))
(define observer-level (+ 1 (max demand-level supply-level)))
(spawn demand-matcher-handle-event (spawn demand-matcher-handle-event
d d
(list (compute-detector #t d) (gestalt-union (sub observer-pattern #:meta-level meta-level #:level observer-level)
(compute-detector #f d)))) (pub observer-pattern #:meta-level meta-level #:level observer-level))))

25
minimart/presence-detector.rkt
View File

@ -1,25 +0,0 @@
#lang racket/base
(require racket/set)
(require racket/match)
(require "core.rkt")
(provide (except-out (struct-out presence-detector) presence-detector)
(rename-out [make-presence-detector presence-detector])
presence-detector-update
presence-detector-routes)
(struct presence-detector (route-set) #:transparent)
(define (make-presence-detector [initial-routes '()])
(presence-detector (list->set initial-routes)))
(define (presence-detector-update p rs)
(define old-route-set (presence-detector-route-set p))
(define new-route-set (list->set rs))
(values (struct-copy presence-detector p [route-set new-route-set])
(set-subtract new-route-set old-route-set)
(set-subtract old-route-set new-route-set)))
(define (presence-detector-routes p)
(set->list (presence-detector-route-set p)))