This commit is contained in:
Tony Garnock-Jones 2012-03-24 19:41:04 -04:00
parent 1696971366
commit 04a537be15
1 changed files with 26 additions and 31 deletions

57
os2.rkt
View File

@ -66,17 +66,18 @@
pending-actions ;; QuasiQueue<(cons PID Action)> pending-actions ;; QuasiQueue<(cons PID Action)>
) #:transparent) ) #:transparent)
(struct endpoint (id ;; EID ;; An Endpoint is an (endpoint EID Topic Handlers), representing a
topic ;; Topic ;; facet of a process responsible for playing a particular role (the
handlers ;; Handlers ;; topic) in a conversation.
) #:transparent) (struct endpoint (id topic handlers) #:transparent)
(struct process (id ;; PID ;; A Process is an Exists State . (process PID State
state ;; NonnegativeInteger Set<EID>), representing a VM process and its
next-endpoint-id-number ;; NonnegativeInteger ;; collection of active endpoints.
endpoints ;; Set<EID> (struct process (id state next-eid-number endpoints) #:transparent)
) #:transparent)
;; A Topic is a (topic Role Pattern Boolean), describing an Endpoint's
;; role in a conversation.
(struct topic (role pattern virtual?) #:prefab) (struct topic (role pattern virtual?) #:prefab)
;; InterruptK = State -> Transition ;; InterruptK = State -> Transition
@ -242,7 +243,7 @@
(define (do-subscribe pid topic hs k state) (define (do-subscribe pid topic hs k state)
(define old-process (hash-ref (vm-processes state) pid)) (define old-process (hash-ref (vm-processes state) pid))
(define eid-number (process-next-endpoint-id-number old-process)) (define eid-number (process-next-eid-number old-process))
(define new-eid (list pid eid-number)) (define new-eid (list pid eid-number))
(struct-copy vm (for*/fold ([state (run-trapk state pid k new-eid)]) (struct-copy vm (for*/fold ([state (run-trapk state pid k new-eid)])
([(matching-pid p) (in-hash (vm-processes state))] ([(matching-pid p) (in-hash (vm-processes state))]
@ -271,7 +272,7 @@
[processes (hash-set (vm-processes state) [processes (hash-set (vm-processes state)
pid pid
(struct-copy process old-process (struct-copy process old-process
[next-endpoint-id-number (+ eid-number 1)] [next-eid-number (+ eid-number 1)]
[endpoints [endpoints
(set-add (process-endpoints old-process) (set-add (process-endpoints old-process)
new-eid)]))] new-eid)]))]
@ -332,8 +333,7 @@
(define (run-trapk state pid trap-k . args) (define (run-trapk state pid trap-k . args)
(if trap-k (if trap-k
(let ((failure-proc (lambda (e) (lambda (process-state) (let ((failure-proc (lambda (e) (lambda (process-state)
(transition process-state (transition process-state (kill #f e))))))
(kill #f e))))))
(run-ready state pid (apply send-to-user failure-proc trap-k args))) (run-ready state pid (apply send-to-user failure-proc trap-k args)))
state)) state))
@ -344,29 +344,26 @@
(define (run-ready state pid interrupt-k) (define (run-ready state pid interrupt-k)
(define old-process (hash-ref (vm-processes state) pid)) (define old-process (hash-ref (vm-processes state) pid))
(match-define (transition new-process-state actions) (define old-state (process-state old-process))
(match-define (transition new-state actions)
(maybe-transition->transition (maybe-transition->transition
(send-to-user (lambda (e) (transition (process-state old-process) (kill #f e))) (send-to-user (lambda (e) (transition old-state (kill #f e))) interrupt-k old-state)))
interrupt-k
(process-state old-process))))
(struct-copy vm (enqueue-actions state pid actions) (struct-copy vm (enqueue-actions state pid actions)
[processes (hash-set (vm-processes state) pid [processes (hash-set (vm-processes state) pid
(struct-copy process old-process (struct-copy process old-process
[state new-process-state]))])) [state new-state]))]))
(define (do-spawn spawning-pid thunk k state) (define (do-spawn spawning-pid thunk k state)
(match-define (transition initial-state initial-actions) (match-define (transition initial-state initial-actions)
(send-to-user (lambda (e) (transition #f (kill #f e))) thunk)) (send-to-user (lambda (e) (transition #f (kill #f e))) thunk))
(define new-pid (vm-next-process-id state)) (define new-pid (vm-next-process-id state))
(run-trapk (struct-copy vm (enqueue-actions state new-pid initial-actions) (define spawned-state
[processes (hash-set (vm-processes state) new-pid (process new-pid (struct-copy vm (enqueue-actions state new-pid initial-actions)
initial-state [processes (hash-set (vm-processes state)
0 new-pid
(set)))] (process new-pid initial-state 0 (set)))]
[next-process-id (+ new-pid 1)]) [next-process-id (+ new-pid 1)]))
spawning-pid (run-trapk spawned-state spawning-pid k new-pid))
k
new-pid))
(define (do-kill pid-to-kill reason state) (define (do-kill pid-to-kill reason state)
(cond (cond
@ -384,10 +381,8 @@
[pending-actions (append (reverse (for/list ([a (flatten actions)]) (cons pid a))) [pending-actions (append (reverse (for/list ([a (flatten actions)]) (cons pid a)))
(vm-pending-actions state))])) (vm-pending-actions state))]))
(define (wrap-trapk pid trapk) (define (((wrap-trapk pid trapk) . args) state)
(lambda args (apply run-trapk state pid trapk args))
(lambda (state)
(apply run-trapk state pid trapk args))))
(define (transform-meta-action pid preaction) (define (transform-meta-action pid preaction)
(match preaction (match preaction