support for dataflow, misc fixes and improvements
This commit is contained in:
parent
3ebcf413c9
commit
703a4c9589
|
@ -36,10 +36,12 @@
|
||||||
;; - (¬Know τ), reaction to retraction
|
;; - (¬Know τ), reaction to retraction
|
||||||
;; - StartEvt, reaction to facet startup
|
;; - StartEvt, reaction to facet startup
|
||||||
;; - StopEvt, reaction to facet shutdown
|
;; - StopEvt, reaction to facet shutdown
|
||||||
|
;; - DataflowEvt, reaction to field updates
|
||||||
(struct Know (ty) #:transparent)
|
(struct Know (ty) #:transparent)
|
||||||
(struct ¬Know (ty) #:transparent)
|
(struct ¬Know (ty) #:transparent)
|
||||||
(define StartEvt 'Start)
|
(define StartEvt 'Start)
|
||||||
(define StopEvt 'Stop)
|
(define StopEvt 'Stop)
|
||||||
|
(define DataflowEvt 'Dataflow)
|
||||||
|
|
||||||
;; a τ is one of
|
;; a τ is one of
|
||||||
;; - (U (Listof τ))
|
;; - (U (Listof τ))
|
||||||
|
@ -324,7 +326,14 @@
|
||||||
;; D -> Bool
|
;; D -> Bool
|
||||||
;; test if D corresponds to an external event (assertion, message)
|
;; test if D corresponds to an external event (assertion, message)
|
||||||
(define (external-evt? D)
|
(define (external-evt? D)
|
||||||
(or (Know? D) (¬Know? D)))
|
(match D
|
||||||
|
[(or (Know _)
|
||||||
|
(¬Know _))
|
||||||
|
#t]
|
||||||
|
[(== DataflowEvt)
|
||||||
|
#t]
|
||||||
|
[_
|
||||||
|
#f]))
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(test-case
|
(test-case
|
||||||
|
@ -608,7 +617,6 @@
|
||||||
;; determine the state resulting from some effects, given the currently active
|
;; determine the state resulting from some effects, given the currently active
|
||||||
;; facets and a description of possible facet locations and behavior.
|
;; facets and a description of possible facet locations and behavior.
|
||||||
(define (apply-effects effs st ft txn#)
|
(define (apply-effects effs st ft txn#)
|
||||||
#;(printf "apply-effects: ~a\n" effs)
|
|
||||||
(let loop ([st st]
|
(let loop ([st st]
|
||||||
[effs effs])
|
[effs effs])
|
||||||
(match effs
|
(match effs
|
||||||
|
@ -623,8 +631,9 @@
|
||||||
[(set-empty? start-effs)
|
[(set-empty? start-effs)
|
||||||
(loop st+ rest)]
|
(loop st+ rest)]
|
||||||
[else
|
[else
|
||||||
(for/set ([eff* (in-set start-effs)])
|
(for*/set ([eff* (in-set start-effs)]
|
||||||
(loop st+ (append rest eff*)))])]
|
[result (in-set (loop st+ (append rest eff*)))])
|
||||||
|
result)])]
|
||||||
[(stop nm)
|
[(stop nm)
|
||||||
;; better include nm
|
;; better include nm
|
||||||
(define children (find-children ft nm st))
|
(define children (find-children ft nm st))
|
||||||
|
@ -896,6 +905,10 @@
|
||||||
;; subtyping lifted over event descriptions
|
;; subtyping lifted over event descriptions
|
||||||
(define (D<:? D1 D2)
|
(define (D<:? D1 D2)
|
||||||
(match (list D1 D2)
|
(match (list D1 D2)
|
||||||
|
[(list _ (== DataflowEvt))
|
||||||
|
;; TODO - sketchy, intuition "dataflow can happen at any time", though it
|
||||||
|
;; might actually take the place of multiple transitions
|
||||||
|
#t]
|
||||||
[(list (Know τ1) (Know τ2))
|
[(list (Know τ1) (Know τ2))
|
||||||
(<:? τ1 τ2)]
|
(<:? τ1 τ2)]
|
||||||
[(list (¬Know τ1) (¬Know τ2))
|
[(list (¬Know τ1) (¬Know τ2))
|
||||||
|
@ -911,17 +924,33 @@
|
||||||
;; Compute the set of assertions the role contributes (on its own, not
|
;; Compute the set of assertions the role contributes (on its own, not
|
||||||
;; considering parent assertions)
|
;; considering parent assertions)
|
||||||
(define (role-assertions r)
|
(define (role-assertions r)
|
||||||
(for/set ([ep (in-list (Role-eps r))])
|
(for*/set ([ep (in-list (Role-eps r))]
|
||||||
(match ep
|
[τ? (in-value (EP-assertion ep))]
|
||||||
[(Shares τ)
|
#:when τ?)
|
||||||
τ]
|
τ?))
|
||||||
[(Reacts evt _)
|
|
||||||
;; TODO - this doesn't put ⋆ in where an underlying pattern uses a capture
|
;; EP -> (U #f τ)
|
||||||
(match evt
|
;; the type of assertion and endpoint contributes, otherwise #f for
|
||||||
[(Know τ)
|
;; dataflow/start/stop
|
||||||
(Observe τ)]
|
(define (EP-assertion EP)
|
||||||
[(¬Know τ)
|
(match EP
|
||||||
(Observe τ)])])))
|
[(Shares τ)
|
||||||
|
τ]
|
||||||
|
[(Reacts D _)
|
||||||
|
(match D
|
||||||
|
[(or (Know τ)
|
||||||
|
(¬Know τ))
|
||||||
|
;; TODO - this doesn't put ⋆ in where an underlying pattern uses a capture
|
||||||
|
(Observe τ)]
|
||||||
|
[_
|
||||||
|
#f])]))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
;; make sure the or pattern above works the way I think it does
|
||||||
|
(check-equal? (EP-assertion (Reacts (Know Int) #f))
|
||||||
|
(Observe Int))
|
||||||
|
(check-equal? (EP-assertion (Reacts (¬Know String) #f))
|
||||||
|
(Observe String)))
|
||||||
|
|
||||||
;; an Equation is (equiv StateName StateName)
|
;; an Equation is (equiv StateName StateName)
|
||||||
;;
|
;;
|
||||||
|
@ -939,34 +968,51 @@
|
||||||
;; matched with an element b of bs, where each b has at least one state
|
;; matched with an element b of bs, where each b has at least one state
|
||||||
;; matched with it.
|
;; matched with it.
|
||||||
(define (make-combinations as bs)
|
(define (make-combinations as bs)
|
||||||
(define combos (make-combinations* as bs))
|
(define (all-as? xs)
|
||||||
(define (all-bs? combo)
|
(for/and ([a (in-set as)])
|
||||||
|
(for/or ([x (in-list xs)])
|
||||||
|
(match-define (equiv xa _) x)
|
||||||
|
(equal? a xa))))
|
||||||
|
(define (all-bs? xs)
|
||||||
(for/and ([b (in-set bs)])
|
(for/and ([b (in-set bs)])
|
||||||
(for/or ([eqn (in-set combo)])
|
(for/or ([x (in-list xs)])
|
||||||
(match-define (equiv _ bb) eqn)
|
(match-define (equiv _ xb) x)
|
||||||
(equal? b bb))))
|
(equal? b xb))))
|
||||||
(for/set ([combo (in-set combos)]
|
(define all-matches
|
||||||
#:when (all-bs? combo))
|
(for*/list ([a (in-set as)]
|
||||||
combo))
|
|
||||||
|
|
||||||
;; (Setof StateName) (Setof StateName) -> (Setof (Setof Equation))
|
|
||||||
;; Like make-combinations, but don't enforce that each b occurs at
|
|
||||||
;; least once in each combination
|
|
||||||
(define (make-combinations* as bs)
|
|
||||||
(cond
|
|
||||||
[(= (set-count as) 1)
|
|
||||||
(for*/set ([a (in-value (set-first as))]
|
|
||||||
[b (in-set bs)])
|
[b (in-set bs)])
|
||||||
(set (equiv a b)))]
|
(equiv a b)))
|
||||||
[else
|
(define combo-size (max (set-count as) (set-count bs)))
|
||||||
(for*/fold ([agg (set)])
|
(for/set ([l-o-m (in-combinations all-matches combo-size)]
|
||||||
([a (in-set as)]
|
#:when (all-as? l-o-m)
|
||||||
[b (in-set bs)])
|
#:when (all-bs? l-o-m))
|
||||||
(define combos (make-combinations* (set-remove as a) bs))
|
(list->set l-o-m)))
|
||||||
(define combos+
|
|
||||||
(for/set ([c (in-set combos)])
|
(module+ test
|
||||||
(set-add c (equiv a b))))
|
(test-case
|
||||||
(set-union agg combos+))]))
|
"potential combinations bug"
|
||||||
|
;; confirmed bug
|
||||||
|
(define dests1 (set (set 'A)))
|
||||||
|
(define dests2 (set (set 'B) (set 'C)))
|
||||||
|
(check-equal? (make-combinations dests1 dests2)
|
||||||
|
(set (set (equiv (set 'A) (set 'B))
|
||||||
|
(equiv (set 'A) (set 'C))))))
|
||||||
|
(test-case
|
||||||
|
"potential combinations bug"
|
||||||
|
(define dests1 (set (set 'B) (set 'C)))
|
||||||
|
(define dests2 (set (set 'A)))
|
||||||
|
(check-equal? (make-combinations dests1 dests2)
|
||||||
|
(set (set (equiv (set 'B) (set 'A))
|
||||||
|
(equiv (set 'C) (set 'A))))))
|
||||||
|
(test-case
|
||||||
|
"another combinations bug"
|
||||||
|
;; returning matches with 3 elements
|
||||||
|
(define dests1 (set (set 'A) (set 'L)))
|
||||||
|
(define dests2 (set (set 'A) (set 'L)))
|
||||||
|
(check-equal? (make-combinations dests1 dests2)
|
||||||
|
(set
|
||||||
|
(set (equiv (set 'L) (set 'A)) (equiv (set 'A) (set 'L)))
|
||||||
|
(set (equiv (set 'L) (set 'L)) (equiv (set 'A) (set 'A)))))))
|
||||||
|
|
||||||
;; Role Role -> Bool
|
;; Role Role -> Bool
|
||||||
;; determine if the first role acts suitably like the second role.
|
;; determine if the first role acts suitably like the second role.
|
||||||
|
@ -976,39 +1022,25 @@
|
||||||
(define (simulates? role1 role2)
|
(define (simulates? role1 role2)
|
||||||
(match-define (role-graph st0-1 st#1) (compile role1))
|
(match-define (role-graph st0-1 st#1) (compile role1))
|
||||||
(match-define (role-graph st0-2 st#2) (compile role2))
|
(match-define (role-graph st0-2 st#2) (compile role2))
|
||||||
(define ft1 (make-facet-tree role1))
|
(define assertion#1 (all-states-assertions (in-hash-keys st#1) role1))
|
||||||
(define ft2 (make-facet-tree role2))
|
(define assertion#2 (all-states-assertions (in-hash-keys st#2) role2))
|
||||||
(define all-roles1 (enumerate-roles role1))
|
|
||||||
(define all-roles2 (enumerate-roles role2))
|
|
||||||
(define assertion#1
|
|
||||||
(for/hash ([role (in-list all-roles1)])
|
|
||||||
(values (Role-nm role)
|
|
||||||
(role-assertions role))))
|
|
||||||
(define assertion#2
|
|
||||||
(for/hash ([role (in-list all-roles2)])
|
|
||||||
(values (Role-nm role)
|
|
||||||
(role-assertions role))))
|
|
||||||
(define state-assertions1
|
|
||||||
(for/hash ([sn (in-hash-keys st#1)])
|
|
||||||
(values sn
|
|
||||||
(for/fold ([assertions (set)])
|
|
||||||
([facet-name (in-set sn)])
|
|
||||||
(set-union assertions (hash-ref assertion#1 facet-name (set)))))))
|
|
||||||
(define state-assertions2
|
|
||||||
(for/hash ([sn (in-hash-keys st#2)])
|
|
||||||
(values sn
|
|
||||||
(for/fold ([assertions (set)])
|
|
||||||
([facet-name (in-set sn)])
|
|
||||||
(set-union assertions (hash-ref assertion#2 facet-name (set)))))))
|
|
||||||
;; Goal (Setof Equation) -> Bool
|
;; Goal (Setof Equation) -> Bool
|
||||||
|
(define not-equiv (mutable-set))
|
||||||
(define (verify goal assumptions)
|
(define (verify goal assumptions)
|
||||||
(let/ec return
|
(let/ec esc
|
||||||
|
(define (return ans)
|
||||||
|
(when (and (equiv? goal)
|
||||||
|
(not ans))
|
||||||
|
(set-add! not-equiv goal))
|
||||||
|
(esc ans))
|
||||||
(match goal
|
(match goal
|
||||||
[(equiv sn1 sn2)
|
[(equiv sn1 sn2)
|
||||||
(when (set-member? assumptions goal)
|
(when (set-member? assumptions goal)
|
||||||
(return #t))
|
(return #t))
|
||||||
(define assertions1 (hash-ref state-assertions1 sn1))
|
(when (set-member? not-equiv goal)
|
||||||
(define assertions2 (hash-ref state-assertions2 sn2))
|
(esc #f))
|
||||||
|
(define assertions1 (hash-ref assertion#1 sn1))
|
||||||
|
(define assertions2 (hash-ref assertion#2 sn2))
|
||||||
(define superset?
|
(define superset?
|
||||||
(for/and ([assertion2 (in-set assertions2)])
|
(for/and ([assertion2 (in-set assertions2)])
|
||||||
(for/or ([assertion1 (in-set assertions1)])
|
(for/or ([assertion1 (in-set assertions1)])
|
||||||
|
@ -1020,13 +1052,18 @@
|
||||||
(define evts1 (hash-keys transitions1))
|
(define evts1 (hash-keys transitions1))
|
||||||
(define evts2 (hash-keys transitions2))
|
(define evts2 (hash-keys transitions2))
|
||||||
(define same-on-specified-events?
|
(define same-on-specified-events?
|
||||||
(for/and ([(D dests2) (in-hash transitions2)])
|
(for/and ([(D2 dests2) (in-hash transitions2)])
|
||||||
(define dests1
|
(define dests1
|
||||||
(for/fold ([agg (set)])
|
(for/fold ([agg (set)])
|
||||||
([(D1 dests) (in-hash transitions1)]
|
([(D1 dests) (in-hash transitions1)]
|
||||||
#:when (D<:? D D1))
|
#:when (D<:? D2 D1)
|
||||||
|
;; only consider dataflow events vs. non-dataflow when
|
||||||
|
;; there is not a dataflow edge in the spec (HACK)
|
||||||
|
#:unless (and (equal? D1 DataflowEvt)
|
||||||
|
(not (equal? D2 DataflowEvt))
|
||||||
|
(hash-has-key? transitions2 D1)))
|
||||||
(set-union agg dests)))
|
(set-union agg dests)))
|
||||||
(unless dests1
|
(when (set-empty? dests1)
|
||||||
(return #f))
|
(return #f))
|
||||||
(define combos (make-combinations dests1 dests2))
|
(define combos (make-combinations dests1 dests2))
|
||||||
(verify (one-of combos) (set-add assumptions goal))))
|
(verify (one-of combos) (set-add assumptions goal))))
|
||||||
|
@ -1042,13 +1079,31 @@
|
||||||
[dest (in-set (hash-ref transitions1 evt))])
|
[dest (in-set (hash-ref transitions1 evt))])
|
||||||
(verify (equiv dest sn2)
|
(verify (equiv dest sn2)
|
||||||
(set-add assumptions goal))))
|
(set-add assumptions goal))))
|
||||||
same-on-extra-evts?]
|
(return same-on-extra-evts?)]
|
||||||
[(one-of matchings)
|
[(one-of matchings)
|
||||||
(for/or ([matching (in-set matchings)])
|
(for/or ([matching (in-set matchings)])
|
||||||
(for/and ([goal (in-set matching)])
|
(for/and ([goal (in-set matching)])
|
||||||
(define hypotheses (set-remove matching goal))
|
(define hypotheses (set-remove matching goal))
|
||||||
(verify goal (set-union hypotheses assumptions))))])))
|
(verify goal (set-union hypotheses assumptions))))])))
|
||||||
(verify (equiv st0-1 st0-2) (set)))
|
(verify (equiv st0-1 st0-2) (set)))
|
||||||
|
|
||||||
|
;; (Sequenceof StateName) Role -> (Hashof StateName (Setof τ))
|
||||||
|
;; map each state name to its active assertions
|
||||||
|
(define (all-states-assertions state-seq role)
|
||||||
|
(define all-roles (enumerate-roles role))
|
||||||
|
(define assertion# (all-roles-assertions all-roles))
|
||||||
|
(for/hash ([sn state-seq])
|
||||||
|
(values sn
|
||||||
|
(for/fold ([assertions (set)])
|
||||||
|
([facet-name (in-set sn)])
|
||||||
|
(set-union assertions (hash-ref assertion# facet-name (set)))))))
|
||||||
|
|
||||||
|
;; (List Role) -> (Hashof RoleName (Setof τ))
|
||||||
|
;; map each role's name to the assertions it contributes
|
||||||
|
(define (all-roles-assertions roles)
|
||||||
|
(for/hash ([role (in-list roles)])
|
||||||
|
(values (Role-nm role)
|
||||||
|
(role-assertions role))))
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(test-case
|
(test-case
|
||||||
|
@ -1171,14 +1226,10 @@
|
||||||
[(== StartEvt)
|
[(== StartEvt)
|
||||||
"Start"]
|
"Start"]
|
||||||
[(== StopEvt)
|
[(== StopEvt)
|
||||||
"Stop"]))
|
"Stop"]
|
||||||
|
[(== DataflowEvt)
|
||||||
|
"Dataflow"]))
|
||||||
|
|
||||||
;; - (U (Listof τ))
|
|
||||||
;; - (Struct StructName (Listof τ ...))
|
|
||||||
;; - (Observe τ)
|
|
||||||
;; - ⋆
|
|
||||||
;; - Int
|
|
||||||
;; - String
|
|
||||||
;; τ -> String
|
;; τ -> String
|
||||||
(define (τ->string τ)
|
(define (τ->string τ)
|
||||||
;; (Listof String) -> String
|
;; (Listof String) -> String
|
||||||
|
@ -1206,86 +1257,6 @@
|
||||||
(paren-join (cons "U" slots))]))
|
(paren-join (cons "U" slots))]))
|
||||||
)
|
)
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
|
||||||
;; Flink Examples
|
|
||||||
|
|
||||||
(define job-manager-actual
|
|
||||||
'(Role
|
|
||||||
(jm)
|
|
||||||
(Shares (JobManagerAlive))
|
|
||||||
(Reacts
|
|
||||||
(Know
|
|
||||||
(Job
|
|
||||||
(Bind Symbol)
|
|
||||||
(Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int)))))))
|
|
||||||
(Role
|
|
||||||
(during-inner)
|
|
||||||
(Reacts
|
|
||||||
OnDataflow
|
|
||||||
(Role
|
|
||||||
(perform)
|
|
||||||
(Reacts
|
|
||||||
OnStart
|
|
||||||
(Role
|
|
||||||
(this-facet)
|
|
||||||
(Reacts
|
|
||||||
OnDataflow
|
|
||||||
(Branch
|
|
||||||
(Effs
|
|
||||||
(Branch
|
|
||||||
(Effs
|
|
||||||
(Role
|
|
||||||
(this-facet)
|
|
||||||
(Shares
|
|
||||||
(TaskAssignment
|
|
||||||
Symbol
|
|
||||||
Symbol
|
|
||||||
(Task
|
|
||||||
Int
|
|
||||||
(U
|
|
||||||
(MapWork String)
|
|
||||||
(ReduceWork (Hash String Int) (Hash String Int))))))
|
|
||||||
(Reacts
|
|
||||||
(Know
|
|
||||||
(TaskState
|
|
||||||
Symbol
|
|
||||||
Symbol
|
|
||||||
Int
|
|
||||||
(Bind (U (Finished (Hash String Int)) Symbol))))
|
|
||||||
(Branch
|
|
||||||
(Effs)
|
|
||||||
(Effs)
|
|
||||||
(Effs (Stop this-facet))
|
|
||||||
(Effs
|
|
||||||
(Stop
|
|
||||||
perform
|
|
||||||
(Branch
|
|
||||||
(Effs
|
|
||||||
(Role
|
|
||||||
(done)
|
|
||||||
(Shares (JobFinished Symbol (Hash String Int)))))
|
|
||||||
(Effs))))))
|
|
||||||
(Reacts
|
|
||||||
OnStart
|
|
||||||
(Role
|
|
||||||
(take-slot)
|
|
||||||
(Reacts
|
|
||||||
(Know (TaskState Symbol Symbol Int Discard))
|
|
||||||
(Stop take-slot))))
|
|
||||||
(Reacts (¬Know (TaskManager Symbol Discard)) (Stop this-facet))))
|
|
||||||
(Effs)))
|
|
||||||
(Effs)))))
|
|
||||||
(Reacts OnStop)
|
|
||||||
(Reacts OnStart)))
|
|
||||||
(Reacts
|
|
||||||
(¬Know
|
|
||||||
(Job
|
|
||||||
Symbol
|
|
||||||
(List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
|
|
||||||
(Stop during-inner))))
|
|
||||||
(Reacts (¬Know (TaskManager (Bind Symbol) (Bind Int))))
|
|
||||||
(Reacts (Know (TaskManager (Bind Symbol) (Bind Int))))))
|
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; Converting types from the turnstile implementation
|
;; Converting types from the turnstile implementation
|
||||||
|
|
||||||
|
@ -1336,7 +1307,9 @@
|
||||||
['OnStart
|
['OnStart
|
||||||
StartEvt]
|
StartEvt]
|
||||||
['OnStop
|
['OnStop
|
||||||
StopEvt]))
|
StopEvt]
|
||||||
|
['OnDataflow
|
||||||
|
DataflowEvt]))
|
||||||
|
|
||||||
;; Sexp -> τ
|
;; Sexp -> τ
|
||||||
(define (parse-τ ty)
|
(define (parse-τ ty)
|
||||||
|
@ -1355,7 +1328,8 @@
|
||||||
(U (map parse-τ t))]
|
(U (map parse-τ t))]
|
||||||
[(list 'Bind t)
|
[(list 'Bind t)
|
||||||
;; TODO : questionable
|
;; TODO : questionable
|
||||||
(parse-τ t)]
|
⋆
|
||||||
|
#;(parse-τ t)]
|
||||||
['Discard
|
['Discard
|
||||||
⋆]
|
⋆]
|
||||||
[(list struct-name tys ...)
|
[(list struct-name tys ...)
|
||||||
|
@ -1375,20 +1349,18 @@
|
||||||
(check-true (Stop? (parse-T '(Stop poll-members
|
(check-true (Stop? (parse-T '(Stop poll-members
|
||||||
(Branch (Effs (Stop get-quotes)) (Effs)))))))
|
(Branch (Effs (Stop get-quotes)) (Effs)))))))
|
||||||
(test-case
|
(test-case
|
||||||
"parsed types are the same as my manual conversions"
|
"parsed types are (not) the same as my manual conversions"
|
||||||
(check-true (simulates? (parse-T real-seller-ty) seller-actual))
|
;; because I parse (Bind τ) as ⋆, whereas my manual conversions use τ
|
||||||
(check-true (simulates? seller-actual (parse-T real-seller-ty)))
|
(check-false (simulates? (parse-T real-seller-ty) seller-actual))
|
||||||
|
(check-false (simulates? seller-actual (parse-T real-seller-ty)))
|
||||||
|
|
||||||
(check-true (simulates? (parse-T real-member-ty) member-actual))
|
(check-false (simulates? (parse-T real-member-ty) member-actual))
|
||||||
(check-true (simulates? member-actual (parse-T real-member-ty)))
|
(check-false (simulates? member-actual (parse-T real-member-ty)))
|
||||||
|
|
||||||
(check-true (simulates? (parse-T real-leader-ty) leader-actual))
|
(check-false (simulates? (parse-T real-leader-ty) leader-actual))
|
||||||
;; interestingly, this doesn't work because leader-actual is less precise
|
(check-false (simulates? leader-actual (parse-T real-leader-ty)))
|
||||||
;; than real-leader-ty (I don't remember how leader-actual lost that
|
(check-false (simulates? (parse-T real-leader-ty) leader-revised))
|
||||||
;; precision)
|
(check-false (simulates? leader-revised (parse-T real-leader-ty)))))
|
||||||
#;(check-true (simulates? leader-actual (parse-T real-leader-ty)))
|
|
||||||
(check-true (simulates? (parse-T real-leader-ty) leader-revised))
|
|
||||||
(check-true (simulates? leader-revised (parse-T real-leader-ty)))))
|
|
||||||
|
|
||||||
(define real-seller-ty
|
(define real-seller-ty
|
||||||
'(Role
|
'(Role
|
||||||
|
@ -1440,3 +1412,92 @@
|
||||||
(Reacts (Know (BookInterestT String (Bind String) Bool)))))))
|
(Reacts (Know (BookInterestT String (Bind String) Bool)))))))
|
||||||
(Reacts (¬Know (ClubMemberT (Bind String))))
|
(Reacts (¬Know (ClubMemberT (Bind String))))
|
||||||
(Reacts (Know (ClubMemberT (Bind String))))))
|
(Reacts (Know (ClubMemberT (Bind String))))))
|
||||||
|
|
||||||
|
;; ---------------------------------------------------------------------------
|
||||||
|
;; Flink Examples
|
||||||
|
|
||||||
|
(define job-manager-actual
|
||||||
|
'(Role
|
||||||
|
(jm)
|
||||||
|
(Shares (JobManagerAlive))
|
||||||
|
(Reacts
|
||||||
|
(Know
|
||||||
|
(Job
|
||||||
|
(Bind Symbol)
|
||||||
|
(Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int)))))))
|
||||||
|
(Role
|
||||||
|
(during-inner)
|
||||||
|
(Reacts
|
||||||
|
OnDataflow
|
||||||
|
(Role
|
||||||
|
(perform)
|
||||||
|
(Reacts
|
||||||
|
OnStart
|
||||||
|
(Role
|
||||||
|
(select)
|
||||||
|
(Reacts
|
||||||
|
OnDataflow
|
||||||
|
(Branch
|
||||||
|
(Effs
|
||||||
|
(Branch
|
||||||
|
(Effs
|
||||||
|
(Role
|
||||||
|
(assign)
|
||||||
|
(Shares
|
||||||
|
(TaskAssignment
|
||||||
|
Symbol
|
||||||
|
Symbol
|
||||||
|
(Task
|
||||||
|
Int
|
||||||
|
(U
|
||||||
|
(MapWork String)
|
||||||
|
(ReduceWork (Hash String Int) (Hash String Int))))))
|
||||||
|
(Reacts
|
||||||
|
(Know
|
||||||
|
(TaskState
|
||||||
|
Symbol
|
||||||
|
Symbol
|
||||||
|
Int
|
||||||
|
(Bind (U (Finished (Hash String Int)) Symbol))))
|
||||||
|
(Branch
|
||||||
|
(Effs)
|
||||||
|
(Effs)
|
||||||
|
(Effs (Stop assign))
|
||||||
|
(Effs
|
||||||
|
(Stop
|
||||||
|
perform
|
||||||
|
(Branch
|
||||||
|
(Effs
|
||||||
|
(Role
|
||||||
|
(done)
|
||||||
|
(Shares (JobFinished Symbol (Hash String Int)))))
|
||||||
|
(Effs))))))
|
||||||
|
(Reacts
|
||||||
|
OnStart
|
||||||
|
(Role
|
||||||
|
(take-slot)
|
||||||
|
(Reacts
|
||||||
|
(Know (TaskState Symbol Symbol Int Discard))
|
||||||
|
(Stop take-slot))))
|
||||||
|
(Reacts (¬Know (TaskManager Symbol Discard)) (Stop assign))))
|
||||||
|
(Effs)))
|
||||||
|
(Effs)))))
|
||||||
|
(Reacts OnStop)
|
||||||
|
(Reacts OnStart)))
|
||||||
|
(Reacts
|
||||||
|
(¬Know
|
||||||
|
(Job
|
||||||
|
Symbol
|
||||||
|
(List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
|
||||||
|
(Stop during-inner))))
|
||||||
|
(Reacts (¬Know (TaskManager (Bind Symbol) (Bind Int))))
|
||||||
|
(Reacts (Know (TaskManager (Bind Symbol) (Bind Int))))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case
|
||||||
|
"job manager reads and compiles"
|
||||||
|
(define jmr (parse-T job-manager-actual))
|
||||||
|
(check-true (Role? jmr))
|
||||||
|
(define jm (compile jmr))
|
||||||
|
(check-true (role-graph? jm))
|
||||||
|
(check-true (simulates? jmr jmr))))
|
||||||
|
|
Loading…
Reference in New Issue