Meta-actions.
This commit is contained in:
parent
244055fffb
commit
dac24674ad
45
os2.rkt
45
os2.rkt
|
@ -16,7 +16,8 @@
|
|||
|
||||
;; A EID is an (arbitrary) VM-unique endpoint identifier. Concretely,
|
||||
;; it's a list of two elements, the first being the endpoint's
|
||||
;; process's PID and the second being an integer.
|
||||
;; process's PID and the second being an integer. (Except for the
|
||||
;; ground-vm, where they're different because there aren't any PIDs.)
|
||||
|
||||
;; One endpoint, one topic.
|
||||
|
||||
|
@ -131,25 +132,26 @@
|
|||
(match remaining-actions
|
||||
['() (transition state (quasi-queue->list outbound-actions))]
|
||||
[(cons (cons pid action) rest)
|
||||
(if (at-meta-level? action)
|
||||
(let-values (((state new-actions)
|
||||
(perform-meta-action pid (at-meta-level-preaction action) state)))
|
||||
(loop rest state (quasi-enqueue-many new-actions outbound-actions)))
|
||||
(loop rest (perform-action pid action state) outbound-actions))])))
|
||||
(match action
|
||||
[(at-meta-level preaction)
|
||||
(define transformed-preaction (transform-meta-action pid preaction))
|
||||
(loop rest state (quasi-enqueue-one transformed-preaction outbound-actions))]
|
||||
[preaction
|
||||
(loop rest (perform-action pid preaction state) outbound-actions)])])))
|
||||
|
||||
(define (run-user-code v)
|
||||
;; TODO: use this hook to find all the bits of code that will need
|
||||
;; with-handlers and crash compensation.
|
||||
v)
|
||||
|
||||
(define (perform-action pid action state)
|
||||
(match action
|
||||
[(add-role topic handlers k) (do-subscribe pid topic handlers k state)]
|
||||
(define (perform-action pid preaction state)
|
||||
(match preaction
|
||||
[(add-role topic hs k) (do-subscribe pid topic hs k state)]
|
||||
[(delete-role eid reason) (do-unsubscribe pid eid reason state)]
|
||||
[(send-message topic body) (route-and-deliver topic body state)]
|
||||
[(spawn thunk k) (do-spawn pid thunk k state)]))
|
||||
|
||||
(define (do-subscribe pid topic handlers k state)
|
||||
(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 new-eid (list pid eid-number))
|
||||
|
@ -164,7 +166,7 @@
|
|||
(define outbound-flow (refine-topic topic flow-pattern))
|
||||
(let* ((state (run-trapk state
|
||||
pid
|
||||
(handlers-presence handlers)
|
||||
(handlers-presence hs)
|
||||
new-eid
|
||||
inbound-flow))
|
||||
(state (run-trapk state
|
||||
|
@ -184,7 +186,7 @@
|
|||
new-eid
|
||||
(endpoint new-eid
|
||||
topic
|
||||
handlers))]))
|
||||
hs))]))
|
||||
|
||||
(define (do-unsubscribe pid eid reason state)
|
||||
(define endpoint-to-remove (hash-ref (vm-endpoints state) eid))
|
||||
|
@ -261,5 +263,20 @@
|
|||
[pending-actions (quasi-enqueue-many (for/list ([a actions]) (cons pid a))
|
||||
(vm-pending-actions state))]))
|
||||
|
||||
(define (perform-meta-action pid preaction state)
|
||||
(error 'perform-meta-action "%%% Not implemented"))
|
||||
(define (wrap-trapk pid trapk)
|
||||
(lambda args
|
||||
(lambda (state)
|
||||
(apply run-trapk state pid trapk args))))
|
||||
|
||||
(define (transform-meta-action pid preaction)
|
||||
(match preaction
|
||||
[(add-role topic hs k)
|
||||
(add-role topic
|
||||
(handlers (wrap-trapk pid (handlers-presence hs))
|
||||
(wrap-trapk pid (handlers-absence hs))
|
||||
(wrap-trapk pid (handlers-message hs)))
|
||||
(wrap-trapk pid k))]
|
||||
[(? delete-role?) preaction]
|
||||
[(? send-message?) preaction]
|
||||
[(spawn thunk k)
|
||||
(spawn thunk (wrap-trapk pid k))]))
|
||||
|
|
Loading…
Reference in New Issue