From e1ca7ba2c4c0ed76ee62ab58c0a046a40b7c070d Mon Sep 17 00:00:00 2001 From: Sam Caldwell Date: Thu, 24 Sep 2020 11:07:30 -0400 Subject: [PATCH] debug state --- racket/typed/examples/roles/flink.rkt | 63 +++++++--- racket/typed/tmp.rkt | 163 ++++++++++++++++++++++++++ 2 files changed, 211 insertions(+), 15 deletions(-) create mode 100644 racket/typed/tmp.rkt diff --git a/racket/typed/examples/roles/flink.rkt b/racket/typed/examples/roles/flink.rkt index b550f68..11201d3 100644 --- a/racket/typed/examples/roles/flink.rkt +++ b/racket/typed/examples/roles/flink.rkt @@ -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))) +|# diff --git a/racket/typed/tmp.rkt b/racket/typed/tmp.rkt new file mode 100644 index 0000000..9c237f9 --- /dev/null +++ b/racket/typed/tmp.rkt @@ -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)))))