task manager role
This commit is contained in:
parent
2a95420366
commit
f3e2fcdc64
|
@ -155,6 +155,13 @@
|
|||
;; describing the initial state and the behavior in each state.
|
||||
(struct role-graph (st0 states) #:transparent)
|
||||
|
||||
;; RoleGraph -> Nat
|
||||
(define (role-graph-size rg)
|
||||
(for/sum ([st (in-hash-values (role-graph-states rg))])
|
||||
(define edge-count (for/sum ([txns (in-hash-values (state-transitions st))])
|
||||
(set-count txns)))
|
||||
(add1 edge-count)))
|
||||
|
||||
;; Role -> RoleGraph
|
||||
;; in each state, the transitions will include the reactions of the parent
|
||||
;; facet(s)
|
||||
|
@ -257,8 +264,11 @@
|
|||
(set)]))
|
||||
(define states
|
||||
(for/hash ([(sn txns) (in-hash st#)]
|
||||
;; get rid of the empty state unless it is the start,
|
||||
;; or some other state transitions to it
|
||||
#:unless (and (set-empty? sn)
|
||||
(not (equal? sn new-st0))))
|
||||
(not (equal? sn new-st0))
|
||||
(not (target-of-transition? sn st#))))
|
||||
(values sn (state sn txns))))
|
||||
(role-graph new-st0 states)]
|
||||
[(cons (work-item from path/r to by with effs) more-work)
|
||||
|
@ -365,14 +375,13 @@
|
|||
(check-equal? i m))
|
||||
(test-case
|
||||
"removing internal events on more involved role"
|
||||
;; though it doesn't use any internal events
|
||||
(define tmr (parse-T task-manager-ty))
|
||||
;; because it doesn't use any internal events, it should be unaffected
|
||||
(define tmr (parse-T task-runner-ty))
|
||||
(define tm (compile tmr))
|
||||
(define tmi (compile/internal-events tm tmr))
|
||||
(check-true (role-graph? tmi))
|
||||
(check-true (simulates?/rg tmi tmr tm tmr))
|
||||
(check-true (simulates?/rg tm tmr tmi tmr))
|
||||
(check-equal? tmi tm))
|
||||
;; I'm not exactly sure how the two should be related via simulation :S
|
||||
(check-true (simulates?/rg tmi tmr tm tmr)))
|
||||
(test-case
|
||||
"detect a simple internal event cycle"
|
||||
(define cyclic
|
||||
|
@ -540,6 +549,14 @@
|
|||
(StartOf? D)
|
||||
(StopOf? D)))
|
||||
|
||||
;; StateName (Hashof StateName (Hashof D+ (Setof Transition))) -> Bool
|
||||
;; do any of the transitions go to `sn`?
|
||||
(define (target-of-transition? sn st#)
|
||||
(for*/or ([txn# (in-hash-values st#)]
|
||||
[txns (in-hash-values txn#)]
|
||||
[txn (in-set txns)])
|
||||
(equal? sn (transition-dest txn))))
|
||||
|
||||
(module+ test
|
||||
(test-case
|
||||
"compile seller"
|
||||
|
@ -1670,7 +1687,7 @@
|
|||
(define tpr (parse-T task-performer-spec))
|
||||
(define tmr (parse-T task-manager-ty))
|
||||
(define ans (simulating-subgraphs tmr tpr))
|
||||
(check-equal? (length ans) 2)
|
||||
(check-equal? (length ans) 68)
|
||||
(define tprg (compile tpr))
|
||||
(check-true (simulates?/rg (first ans) tmr tprg tpr))
|
||||
(check-true (simulates?/rg (second ans) tmr tprg tpr))))
|
||||
|
@ -2412,9 +2429,74 @@
|
|||
(check-false (empty? ans))))
|
||||
|
||||
(define task-manager-ty
|
||||
'())
|
||||
`(Role
|
||||
(tm)
|
||||
(Reacts
|
||||
(Asserted (JobManagerAlive))
|
||||
(Role
|
||||
(during-inner2)
|
||||
(Shares (TaskManager Symbol Int))
|
||||
(Reacts
|
||||
(Asserted
|
||||
(Observe
|
||||
(TaskPerformance
|
||||
Symbol
|
||||
(Bind
|
||||
(Task
|
||||
(Tuple Int Symbol)
|
||||
(U
|
||||
(MapWork String)
|
||||
(ReduceWork (Hash String Int) (Hash String Int)))))
|
||||
Discard)))
|
||||
(Role
|
||||
(during-inner3)
|
||||
(Shares
|
||||
(TaskPerformance
|
||||
Symbol
|
||||
(Task
|
||||
(Tuple Int Symbol)
|
||||
(U
|
||||
(MapWork String)
|
||||
(ReduceWork (Hash String Int) (Hash String Int))))
|
||||
(U (Finished (Hash String Int)) Symbol)))
|
||||
(Reacts
|
||||
(Asserted
|
||||
(TaskPerformance
|
||||
Symbol
|
||||
(Task
|
||||
(Tuple Int Symbol)
|
||||
(U
|
||||
(MapWork String)
|
||||
(ReduceWork (Hash String Int) (Hash String Int))))
|
||||
(Bind (U (Finished (Hash String Int)) Symbol)))))
|
||||
(Reacts OnStop)
|
||||
(Reacts
|
||||
(Retracted
|
||||
(Observe
|
||||
(TaskPerformance
|
||||
Symbol
|
||||
(Task
|
||||
(Tuple Int Symbol)
|
||||
(U
|
||||
(MapWork String)
|
||||
(ReduceWork (Hash String Int) (Hash String Int))))
|
||||
Discard)))
|
||||
(Stop during-inner3))))
|
||||
(Reacts OnDataflow)
|
||||
(Reacts
|
||||
OnStart
|
||||
(Role
|
||||
(monitor-task-runner)
|
||||
(Reacts
|
||||
(Retracted (TaskRunner Symbol))
|
||||
(Spawn ,task-runner-ty))
|
||||
(Reacts (Asserted (TaskRunner Symbol)))
|
||||
(Reacts
|
||||
OnStart
|
||||
(Spawn ,task-runner-ty))))
|
||||
(Reacts (Retracted (JobManagerAlive)) (Stop during-inner2))))))
|
||||
|
||||
#;(module+ test
|
||||
(module+ test
|
||||
(test-case "parse and compile task-manager-ty"
|
||||
(check-true (Role? (parse-T task-manager-ty)))
|
||||
(check-true (role-graph? (compile (parse-T task-manager-ty)))))
|
||||
|
|
Loading…
Reference in New Issue