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