debug state

This commit is contained in:
Sam Caldwell 2020-09-24 11:07:30 -04:00
parent 4e97151cc5
commit 721fb1c30f
2 changed files with 211 additions and 15 deletions

View File

@ -3,6 +3,8 @@
;; ---------------------------------------------------------------------------------------------------
;; Protocol
#|
#|
Conversations in the flink dataspace primarily concern two topics: presence and
task execution.
@ -168,9 +170,14 @@ The JobManager then performs the job and, when finished, asserts
(printf fmt . args)
(printf "\n")))
|#
;; ---------------------------------------------------------------------------------------------------
;; TaskRunner
#|
(define (word-count-increment [h : WordCount]
[word : String]
-> WordCount)
@ -214,6 +221,7 @@ The JobManager then performs the job and, when finished, asserts
;; ---------------------------------------------------------------------------------------------------
;; TaskManager
(define (spawn-task-manager [num-task-runners : Int])
(define id (gensym 'task-manager))
(spawn τc
@ -281,23 +289,9 @@ The JobManager then performs the job and, when finished, asserts
[(finished discard)
(set! status st)])))))))))
;; ---------------------------------------------------------------------------------------------------
;; JobManager
;; Task -> Bool
;; Test if the task is ready to run
(define (task-ready? [t : PendingTask] -> (Maybe ConcreteTask))
(match t
[(task $tid (map-work $s))
;; having to re-produce this is directly bc of no occurrence typing
(some (task tid (map-work s)))]
[(task $tid (reduce-work (right $v1)
(right $v2)))
(some (task tid (reduce-work v1 v2)))]
[_
none]))
;; Task Int Any -> Task
;; If the given task is waiting for this data, replace the waiting ID with the data
(define (task+data [t : PendingTask]
@ -320,8 +314,23 @@ The JobManager then performs the job and, when finished, asserts
-> (Tuple (List X) (List X))))
(define l (split-at/lenient- xs n))
(tuple (first l) (second l)))
|#
(define (partition-ready-tasks [tasks : (List PendingTask)]
;; Task -> Bool
;; Test if the task is ready to run
#;(define (task-ready? [t : PendingTask] -> (Maybe ConcreteTask))
(match t
[(task $tid (map-work $s))
;; having to re-produce this is directly bc of no occurrence typing
(some (task tid (map-work s)))]
[(task $tid (reduce-work (right $v1)
(right $v2)))
(some (task tid (reduce-work v1 v2)))]
[_
none]))
#;(define (partition-ready-tasks [tasks : (List PendingTask)]
-> (Tuple (List PendingTask)
(List ConcreteTask)))
(define part (inst partition/either PendingTask PendingTask ConcreteTask))
@ -333,6 +342,28 @@ The JobManager then performs the job and, when finished, asserts
[none
(left t)]))))
(define (partition-ready-tasks [tasks : (List Int)]
-> (Tuple (List Int)
(List Int)))
(define part (inst partition/either Int Int Int))
(part tasks
(lambda ([t : Int])
(right 0)
#;(match (some 5)
[(some $ct)
(right ct)]
[none
(left 0)]))))
#;(define (debug [tasks : (List Int)] -> (Tuple (List String) (List Int)))
(define part (inst partition/either Int String Int))
(tuple (list) (list))
(part tasks
(lambda ([t : Int])
(left "hi"))))
#|
(define (input->pending-task [t : InputTask] -> PendingTask)
(match t
[(task $id (map-work $s))
@ -341,6 +372,7 @@ The JobManager then performs the job and, when finished, asserts
[(task $id (reduce-work $l $r))
(task id (reduce-work (left l) (left r)))]))
(message-struct tasks-finished : TasksFinished (id results))
;; assertions used for internal slot-management protocol
@ -528,3 +560,4 @@ The JobManager then performs the job and, when finished, asserts
(spawn-task-manager 3)
(spawn-client (file->job "lorem.txt"))
(spawn-client (string->job INPUT)))
|#

163
racket/typed/tmp.rkt Normal file
View File

@ -0,0 +1,163 @@
#lang typed/syndicate/roles
#;(require "core-types.rkt")
#;(require "core-expressions.rkt")
#;(require "prim.rkt")
#;(require "for-loops.rkt")
#;(require "list.rkt")
#;(require "roles.rkt")
#;(require "maybe.rkt")
#;(require macro-debugger/stepper)
;; (define-type-alias ID Symbol)
;; (require-struct task #:as Task #:from "examples/roles/flink-support.rkt")
;; (require-struct map-work #:as MapWork #:from "examples/roles/flink-support.rkt")
;; (require-struct reduce-work #:as ReduceWork #:from "examples/roles/flink-support.rkt")
;; (define-type-alias TaskID (Tuple Int ID))
;; (define-type-alias WordCount (Hash String Int))
;; (define-type-alias TaskResult WordCount)
;; (define-type-alias Reduce
;; (ReduceWork (Either Int TaskResult)
;; (Either Int TaskResult)))
;; (define-type-alias Work
;; (U Reduce (MapWork String)))
;; (define-type-alias ConcreteWork
;; (U (ReduceWork TaskResult TaskResult)
;; (MapWork String)))
;; (define-type-alias PendingTask
;; (Task TaskID Work))
;; (define-type-alias ConcreteTask
;; (Task TaskID ConcreteWork))
#;(define (task-ready? [t : PendingTask] -> (Maybe ConcreteTask))
(match t
#;[(tuple $tid)
;; having to re-produce this is directly bc of no occurrence typing
(some (task tid (map-work s)))]
#;[(task $tid (reduce-work (right $v1)
(right $v2)))
(some (task tid (reduce-work v1 v2)))]
[_
none]))
#;(cons (lambda () 0) (ann (list) (List (→fn Int))))
#;(Λ (X) (lambda ([x (Maybe X)]) (match x [none #f])))
#;(lambda ([x Int]) (match x [none #f]))
#;(match 1 [none #f])
#;(if #t 1 none)
#;none
#;(define ( (X) (unwrap! [x : (Maybe X)] -> Bool))
#;(error "")
(match x
#;[(some (bind v X))
v]
[none
#f
#;(error "none")]))
#;(lambda ([tasks : (List (Maybe Int))])
(define part (inst partition/either (Maybe Int) Int Int))
(part tasks
(lambda ([t : (Maybe Int)])
(left 0)
#;(match t
[(some $ct)
(right ct)]
[none
(left 0)]))))
#;(define (debug [tasks : (List Int)] -> (Tuple (List String) (List Int)))
(define part (inst partition/either Int String Int))
(part tasks
(lambda ([t : Int])
(left "hi"))))
(define (partition-ready-tasks [tasks : (List Int)]
-> (Tuple (List Int)
(List Int)))
(define part (inst partition/either Int Int Int))
(part tasks
(lambda ([t : Int])
(right 0)
#;(match (some 5)
[(some $ct)
(right ct)]
[none
(left 0)]))))
#;(define id : ( (X) (→fn X (List X) (List X)))
(Λ (X) (lambda ([x X] [y (List X)]) (list x))))
#;(spawn (U)
(start-facet echo
(on (message (tuple 1 1))
#f)))
#;(for/fold ([acc Int 0])
([x (list 1)])
x)
#;(define-constructor* (left : Left v))
#;(define (f [x (Left Int)] -> Int)
(define y x)
(match y
[(left (bind z Int))
z]))
#;(#%app- expand/step #'(lambda ([x : Int])
(define y x)
y))
#;(lambda ([x : Int])
(define y x)
y)
#;(begin-for-syntax
(define t #'(Maybe Unit))
(define t- ((current-type-eval) t))
(values #;displayln ((current-type?) t-))
(define tt (syntax-parse (detach t- ':)
[(#%plain-app x) #'x]))
(pretty-print (syntax-debug-info tt)))
#;(begin-for-syntax
(define t #'PendingTask)
(define t- ((current-type-eval) t))
(displayln ((current-type?) t-))
)
#;(define t1 '( (Computation (Value ★/t)
(Endpoints)
(Roles (Branch (Effs (Realizes (TasksFinished- Symbol (Hash- String Int))))
(Effs (Branch (Effs (Realizes (TaskIsReady- Symbol (Task- (Tuple- Int Symbol) (U* (MapWork- String) (ReduceWork- (Hash- String Int) (Hash- String Int)))))))
(Effs)))))
(Spawns))
(Tuple- Int Symbol)
(Hash- String Int)))
#;(define t2 '( (Computation (Value ★/t)
(Endpoints)
(Roles (Branch (Effs (Realizes (TasksFinished- Symbol (Hash- String Int))))
(Effs (Branch (Effs (Realizes (TaskIsReady- Symbol (Task- (Tuple- Int Symbol) (U* (MapWork- String) (ReduceWork- (Hash- String Int) (Hash- String Int)))))))
(Effs)))))
(Spawns))
(Tuple- Int Symbol)
(Hash- String Int)))
#;(lambda ()
(role-strings
(start-facet x
(define (push-results)
(cond
[(zero? 0)
(start-facet done (assert #t))]
[else
#f]))
(define ( (ρ) (perform-task [k : (proc -> ★/t #:roles (ρ))]))
(start-facet perform
(on start (stop perform (k)))))
(on start (call/inst perform-task push-results)))))