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

stuff

This commit is contained in:
Sam Caldwell 2019-12-30 16:27:29 -05:00
parent f5331eb24f
commit 8afed87e99
2 changed files with 276 additions and 388 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/typed/examples/roles/flink.rkt
View File

@ -126,7 +126,8 @@ TaskRunners.
(Role (listen) (Role (listen)
(During (Observe (TaskPerformance ID ConcreteTask ★/t)) (During (Observe (TaskPerformance ID ConcreteTask ★/t))
;; would be nice to say how the IDs and TaskIDs relate to each other ;; would be nice to say how the IDs and TaskIDs relate to each other
(Shares (TaskPerformance TaskID TaskStateDesc))))) ;; BUG in spec; ConcreteTask used to be just TaskID (when I streamlined protocol)
(Shares (TaskPerformance ID ConcreteTask TaskStateDesc)))))
#| #|
Job Submission Protocol Job Submission Protocol

661
racket/typed/proto.rkt
View File

@ -174,6 +174,7 @@
(define (build-transitions D effs) (define (build-transitions D effs)
(for*/set ([eff* (in-set effs)] (for*/set ([eff* (in-set effs)]
[txn (in-set (apply-effects eff* current ft roles#))] [txn (in-set (apply-effects eff* current ft roles#))]
;; TODO - why?
;; filter effect-free self-loops ;; filter effect-free self-loops
#:unless (and (empty? (transition-effs txn)) #:unless (and (empty? (transition-effs txn))
(equal? (transition-dest txn) current))) (equal? (transition-dest txn) current)))
@ -2276,84 +2277,80 @@
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Flink Examples ;; Flink Examples
(define job-manager-actual (define task-assigner-spec
'(Role '(Role
(jm) (assign)
(Shares (JobManagerAlive)) (Shares
(Reacts (Observe
(Asserted (TaskPerformance
(Job Symbol
(Bind Symbol) (Task
(Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int))))))) (Tuple Int Symbol)
(Role (U (MapWork String) (ReduceWork (Hash String Int) (Hash String Int))))
(during-inner) ★/t)))
(Reacts (Reacts
OnDataflow (Asserted
(Role (TaskPerformance
(perform) Symbol
(Reacts (Task
OnStart (Tuple Int Symbol)
(Role (U (MapWork String) (ReduceWork (Hash String Int) (Hash String Int))))
(select) ★/t))
(Reacts (Branch (Stop assign) (Effs)))))
OnDataflow
(Branch
(Effs
(Branch
(Effs
(Role
(assign)
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Reacts
(Asserted
(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
(Asserted (TaskState Symbol Symbol Int Discard))
(Stop take-slot))))
(Reacts (Retracted (TaskManager Symbol Discard)) (Stop assign))))
(Effs)))
(Effs)))))
(Reacts OnStop)
(Reacts OnStart)))
(Reacts
(Retracted
(Job
Symbol
(List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
(Stop during-inner))))
(Reacts (Retracted (TaskManager (Bind Symbol) (Bind Int))))
(Reacts (Asserted (TaskManager (Bind Symbol) (Bind Int))))))
(module+ test (module+ test
(test-case "parse and compile task-assigner-spec"
(check-true (Role? (parse-T task-assigner-spec)))
(check-true (role-graph? (compile (parse-T task-assigner-spec))))))
(define task-performer-spec
'(Role
(listen)
(Reacts
(Asserted
(Observe-
(TaskPerformance-
Symbol
(Task-
(Tuple- Int Symbol)
(U
(MapWork- String)
(ReduceWork- (Hash- String Int) (Hash- String Int))))
★/t)))
(Role
(during-inner)
(Reacts
(Retracted
(Observe-
(TaskPerformance-
Symbol
(Task-
(Tuple- Int Symbol)
(U
(MapWork- String)
(ReduceWork- (Hash- String Int) (Hash- String Int))))
★/t)))
(Stop during-inner))
(Shares
(TaskPerformance-
Symbol
(Task-
(Tuple- Int Symbol)
(U
(MapWork- String)
(ReduceWork- (Hash- String Int) (Hash- String Int))))
(U (Finished- (Hash- String Int)) Symbol)))))))
(module+ test
(test-case "parse and compile task-performer-spec"
(check-true (Role? (parse-T task-performer-spec)))
(check-true (role-graph? (compile (parse-T task-performer-spec))))))
(define job-manager-actual
'())
#;(module+ test
(test-case (test-case
"job manager reads and compiles" "job manager reads and compiles"
(define jmr (parse-T job-manager-actual)) (define jmr (parse-T job-manager-actual))
@ -2362,162 +2359,62 @@
(check-true (role-graph? jm)) (check-true (role-graph? jm))
(check-true (simulates? jmr jmr)))) (check-true (simulates? jmr jmr))))
(define task-performer-spec
'(Role
(listen)
(Reacts
(Asserted
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Role
(during-inner)
(Reacts
(Retracted
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Stop during-inner))
(Shares
(TaskState
Symbol
Symbol
Int
(U (Finished (Hash String Int)) Symbol)))))))
(module+ test
(test-case "parse and compile task-performer-spec"
(check-true (Role? (parse-T task-performer-spec)))
(check-true (role-graph? (compile (parse-T task-performer-spec))))))
(define task-runner-ty (define task-runner-ty
'(Role '(Role
(runner) (runner)
(Shares (TaskRunner Symbol (U (Executing Int) Symbol))) (Shares (TaskRunner Symbol))
(Reacts (Reacts
(Asserted (Asserted
(TaskAssignment (Observe
Symbol (TaskPerformance
(Bind Symbol) Symbol
(Task
(Bind Int)
(Bind (Bind
(U (Task
(MapWork String) (Tuple Int Symbol)
(ReduceWork (Hash String Int) (Hash String Int))))))) (U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int)))))
Discard)))
(Role (Role
(during-inner) (during-inner)
(Shares (Shares
(TaskState Symbol Symbol Int (U (Finished (Hash String Int)) Symbol))) (TaskPerformance
Symbol
(Task
(Tuple Int Symbol)
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))
(U (Finished (Hash String Int)) Symbol)))
(Reacts (Reacts
(Retracted (Retracted
(TaskAssignment (Observe
Symbol (TaskPerformance
Symbol Symbol
(Task (Task
Int (Tuple Int Symbol)
(U (U
(MapWork String) (MapWork String)
(ReduceWork (Hash String Int) (Hash String Int)))))) (ReduceWork (Hash String Int) (Hash String Int))))
Discard)))
(Stop during-inner)))) (Stop during-inner))))
(Reacts OnDataflow))) (Reacts (Retracted (TaskManager Symbol Discard)) (Stop runner))))
(module+ test (module+ test
(test-case "parse and compile task-runner-ty" (test-case "parse and compile task-runner-ty"
(check-true (Role? (parse-T task-runner-ty))) (check-true (Role? (parse-T task-runner-ty)))
(check-true (role-graph? (compile (parse-T task-runner-ty)))) (check-true (role-graph? (compile (parse-T task-runner-ty)))))
(check-true (simulates? (parse-T task-runner-ty) (test-case "task-runner subgraph(s) simulate task-performer"
(parse-T task-performer-spec))))) (define tr (parse-T task-runner-ty))
(define tpr (parse-T task-performer-spec))
(define task-assigner-spec (define ans (run/timeout (thunk (simulating-subgraphs tr tpr))))
'(Role (check-true (list? ans))
(assign) (check-false (empty? ans))))
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Reacts
(Asserted (TaskState Symbol Symbol Int ★/t))
())))
(module+ test
(test-case "parse and compile task-assigner-spec"
(check-true (Role? (parse-T task-assigner-spec)))
(check-true (role-graph? (compile (parse-T task-assigner-spec))))))
(define task-manager-ty (define task-manager-ty
'(Role '())
(tm)
(Reacts
(Asserted (JobManagerAlive))
(Role
(during-inner1)
(Shares (TaskManager Symbol Int))
(Reacts
(Asserted
(TaskAssignment
Symbol
(Bind Symbol)
(Task
(Bind Int)
(Bind
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int)))))))
(Role
(during-inner2)
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Shares
(TaskState Symbol Symbol Int (U (Finished (Hash String Int)) Symbol)))
(Reacts
(Asserted
(TaskState
Symbol
Symbol
Int
(Bind (U (Finished (Hash String Int)) Symbol)))))
(Reacts OnStop)
(Reacts
(Retracted
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Stop during-inner2))))
(Reacts (Retracted (TaskRunner (Bind Symbol) (U (Executing Int) Symbol))))
(Reacts (Asserted (TaskRunner (Bind Symbol) (U (Executing Int) Symbol))))
(Reacts (Retracted (TaskRunner (Bind Symbol) Discard)))
(Reacts (Asserted (TaskRunner (Bind Symbol) Discard)))
(Reacts (Retracted (JobManagerAlive)) (Stop during-inner1))))))
(module+ test #;(module+ test
(test-case "parse and compile task-manager-ty" (test-case "parse and compile task-manager-ty"
(check-true (Role? (parse-T task-manager-ty))) (check-true (Role? (parse-T task-manager-ty)))
(check-true (role-graph? (compile (parse-T task-manager-ty))))) (check-true (role-graph? (compile (parse-T task-manager-ty)))))
@ -2529,95 +2426,8 @@
(check-false (simulates? tm (parse-T task-assigner-spec))) (check-false (simulates? tm (parse-T task-assigner-spec)))
(check-false (simulates? tm (parse-T task-performer-spec))))) (check-false (simulates? tm (parse-T task-performer-spec)))))
;; has a bug with done facet dying too soon
(define job-manager-v2
'(Role
(jm)
(Shares (JobManagerAlive))
(Reacts
(Asserted
(Job
(Bind Symbol)
(Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int)))))))
(Role
(during-inner)
(Reacts
OnStart
(Role
(delegate-tasks)
(Reacts
OnDataflow
(Role
(perform)
(Reacts
OnStart
(Role
(select)
(Reacts (Forget (SelectedTM (Bind Symbol))))
(Reacts
OnDataflow
(Branch
(Effs
(Branch
(Effs
(Role
(assign)
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Know (SelectedTM Symbol))
(Reacts
(Asserted
(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))))
(Realizes (TasksFinished Symbol)))
(Effs))))))
(Reacts
OnStart
(Role
(take-slot)
(Reacts
(Asserted (TaskState Symbol Symbol Int Discard))
(Stop take-slot))))
(Reacts
(Retracted (TaskManager Symbol Discard))
(Stop assign))))
(Effs)))
(Effs)))))
(Reacts OnStop)
(Reacts OnStart)))
(Reacts (Realize (TasksFinished Symbol)) (Stop delegate-tasks))))
(Reacts
(Retracted
(Job
Symbol
(List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
(Stop during-inner))))
(Reacts (Retracted (TaskManager (Bind Symbol) (Bind Int))))
(Reacts (Asserted (TaskManager (Bind Symbol) (Bind Int))))))
(module+ test #;(module+ test
(test-case (test-case
"job manager with internal events basic functionality" "job manager with internal events basic functionality"
(define jmr (run/timeout (thunk (label-internal-events (parse-T job-manager-v2))))) (define jmr (run/timeout (thunk (label-internal-events (parse-T job-manager-v2)))))
@ -2634,106 +2444,183 @@
(check-true (list? ans)) (check-true (list? ans))
(check-false (empty? ans)))) (check-false (empty? ans))))
;; fixed above bug (module+ done-facet-dying-too-soon
(define job-manager-v3 ;; has a bug with done facet dying too soon
'(Role (define job-manager-v2
(jm) '(Role
(Shares (JobManagerAlive)) (jm)
(Reacts (Shares (JobManagerAlive))
(Asserted
(Job
(Bind Symbol)
(Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int)))))))
(Role
(during-inner)
(Reacts (Reacts
OnStart (Asserted
(Job
(Bind Symbol)
(Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int)))))))
(Role (Role
(delegate-tasks) (during-inner)
(Reacts (Reacts
OnDataflow OnStart
(Role (Role
(perform) (delegate-tasks)
(Reacts (Reacts
OnStart OnDataflow
(Role (Role
(select) (perform)
(Reacts (Forget (SelectedTM (Bind Symbol))))
(Reacts (Reacts
OnDataflow OnStart
(Branch (Role
(Effs (select)
(Reacts (Forget (SelectedTM (Bind Symbol))))
(Reacts
OnDataflow
(Branch (Branch
(Effs (Effs
(Role (Branch
(assign) (Effs
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Know (SelectedTM Symbol))
(Reacts
(Asserted
(TaskState
Symbol
Symbol
Int
(Bind (U (Finished (Hash String Int)) Symbol))))
(Branch
(Effs)
(Effs)
(Effs (Stop assign))
(Effs
(Stop
perform
(Branch
(Effs
(Realizes (TasksFinished Symbol (Hash String Int))))
(Effs))))))
(Reacts
OnStart
(Role (Role
(take-slot) (assign)
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Know (SelectedTM Symbol))
(Reacts (Reacts
(Asserted (TaskState Symbol Symbol Int Discard)) (Asserted
(Stop take-slot)))) (TaskState
(Reacts Symbol
(Retracted (TaskManager Symbol Discard)) Symbol
(Stop assign)))) Int
(Effs))) (Bind (U (Finished (Hash String Int)) Symbol))))
(Effs))))) (Branch
(Reacts OnStop) (Effs)
(Reacts OnStart))) (Effs)
(Effs (Stop assign))
(Effs
(Stop
perform
(Branch
(Effs
(Role
(done)
(Shares (JobFinished Symbol (Hash String Int))))
(Realizes (TasksFinished Symbol)))
(Effs))))))
(Reacts
OnStart
(Role
(take-slot)
(Reacts
(Asserted (TaskState Symbol Symbol Int Discard))
(Stop take-slot))))
(Reacts
(Retracted (TaskManager Symbol Discard))
(Stop assign))))
(Effs)))
(Effs)))))
(Reacts OnStop)
(Reacts OnStart)))
(Reacts (Realize (TasksFinished Symbol)) (Stop delegate-tasks))))
(Reacts (Reacts
(Realize (TasksFinished Symbol (Bind (Hash String Int)))) (Retracted
(Stop (Job
delegate-tasks Symbol
(Role (done) (Shares (JobFinished Symbol (Hash String Int)))))))) (List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
(Reacts (Stop during-inner))))
(Retracted (Reacts (Retracted (TaskManager (Bind Symbol) (Bind Int))))
(Job (Reacts (Asserted (TaskManager (Bind Symbol) (Bind Int))))))
Symbol
(List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
(Stop during-inner))))
(Reacts (Retracted (TaskManager (Bind Symbol) (Bind Int))))
(Reacts (Asserted (TaskManager (Bind Symbol) (Bind Int))))))
(module+ test ;; fixed above bug
(test-case (define job-manager-v3
"job manager v3 basic functionality" '(Role
(define jmr (run/timeout (thunk (parse-T job-manager-v3)))) (jm)
(check-true (Role? jmr)) (Shares (JobManagerAlive))
(define jmrg (run/timeout (thunk (compile jmr)))) (Reacts
(check-true (role-graph? jmrg)) (Asserted
(check-true (run/timeout (thunk (simulates? jmr jmr)))) (Job
(define jmrgi (run/timeout (thunk (compile/internal-events jmrg jmr)))) (Bind Symbol)
(check-true (role-graph? jmrgi)) (Bind (List (Task Int (U (MapWork String) (ReduceWork Int Int)))))))
(check-true (run/timeout (thunk (simulates?/rg jmrgi jmr jmrgi jmr)))))) (Role
(during-inner)
(Reacts
OnStart
(Role
(delegate-tasks)
(Reacts
OnDataflow
(Role
(perform)
(Reacts
OnStart
(Role
(select)
(Reacts (Forget (SelectedTM (Bind Symbol))))
(Reacts
OnDataflow
(Branch
(Effs
(Branch
(Effs
(Role
(assign)
(Shares
(TaskAssignment
Symbol
Symbol
(Task
Int
(U
(MapWork String)
(ReduceWork (Hash String Int) (Hash String Int))))))
(Know (SelectedTM Symbol))
(Reacts
(Asserted
(TaskState
Symbol
Symbol
Int
(Bind (U (Finished (Hash String Int)) Symbol))))
(Branch
(Effs)
(Effs)
(Effs (Stop assign))
(Effs
(Stop
perform
(Branch
(Effs
(Realizes (TasksFinished Symbol (Hash String Int))))
(Effs))))))
(Reacts
OnStart
(Role
(take-slot)
(Reacts
(Asserted (TaskState Symbol Symbol Int Discard))
(Stop take-slot))))
(Reacts
(Retracted (TaskManager Symbol Discard))
(Stop assign))))
(Effs)))
(Effs)))))
(Reacts OnStop)
(Reacts OnStart)))
(Reacts
(Realize (TasksFinished Symbol (Bind (Hash String Int))))
(Stop
delegate-tasks
(Role (done) (Shares (JobFinished Symbol (Hash String Int))))))))
(Reacts
(Retracted
(Job
Symbol
(List (Task Int (U (MapWork String) (ReduceWork Int Int))))))
(Stop during-inner))))
(Reacts (Retracted (TaskManager (Bind Symbol) (Bind Int))))
(Reacts (Asserted (TaskManager (Bind Symbol) (Bind Int)))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Message Examples/Tests ;; Message Examples/Tests