General RPC-management utilities.
This commit is contained in:
parent
0af0e9ffa3
commit
204edd2679
|
@ -24,8 +24,7 @@
|
||||||
(struct-out credit)
|
(struct-out credit)
|
||||||
|
|
||||||
(struct-out rpc-request)
|
(struct-out rpc-request)
|
||||||
(struct-out rpc-reply)
|
(struct-out rpc-reply) ;; error is a kind of reply; crashes are detected via disconnection
|
||||||
(struct-out rpc-error)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(struct arrived (who) #:prefab) ;; someone arrived
|
(struct arrived (who) #:prefab) ;; someone arrived
|
||||||
|
@ -36,7 +35,6 @@
|
||||||
|
|
||||||
(struct rpc-request (reply-to id body) #:prefab)
|
(struct rpc-request (reply-to id body) #:prefab)
|
||||||
(struct rpc-reply (id body) #:prefab)
|
(struct rpc-reply (id body) #:prefab)
|
||||||
(struct rpc-error (id reason) #:prefab)
|
|
||||||
|
|
||||||
(struct room (name ch))
|
(struct room (name ch))
|
||||||
|
|
||||||
|
|
|
@ -11,6 +11,8 @@
|
||||||
;; no. 8, pp. 274-279.
|
;; no. 8, pp. 274-279.
|
||||||
|
|
||||||
(require "functional-queue.rkt")
|
(require "functional-queue.rkt")
|
||||||
|
(require "conversation.rkt")
|
||||||
|
(require racket/class)
|
||||||
|
|
||||||
(provide make-transaction-manager
|
(provide make-transaction-manager
|
||||||
|
|
||||||
|
@ -22,7 +24,10 @@
|
||||||
|
|
||||||
transaction?
|
transaction?
|
||||||
transaction-context
|
transaction-context
|
||||||
transaction-value)
|
transaction-value
|
||||||
|
|
||||||
|
room-rpc
|
||||||
|
room-rpc-finish)
|
||||||
|
|
||||||
(struct transaction-manager (queue) #:transparent)
|
(struct transaction-manager (queue) #:transparent)
|
||||||
|
|
||||||
|
@ -58,3 +63,18 @@
|
||||||
(when (not (transaction-ready? txn))
|
(when (not (transaction-ready? txn))
|
||||||
(error 'transaction-value "Attempt to extract value from unclosed transaction"))
|
(error 'transaction-value "Attempt to extract value from unclosed transaction"))
|
||||||
(transaction-value* txn))
|
(transaction-value* txn))
|
||||||
|
|
||||||
|
(define (room-rpc handle manager message k)
|
||||||
|
(define-values (txn new-manager) (open-transaction manager k))
|
||||||
|
(send handle say (rpc-request (send handle reply-name) txn message))
|
||||||
|
new-manager)
|
||||||
|
|
||||||
|
(define (room-rpc-finish manager txn message)
|
||||||
|
(close-transaction! txn (lambda args (apply (transaction-context txn) message args)))
|
||||||
|
(collect-ready-work '() manager))
|
||||||
|
|
||||||
|
(define (collect-ready-work work manager)
|
||||||
|
(if (transaction-available? manager)
|
||||||
|
(let-values (((txn rest) (dequeue-transaction manager)))
|
||||||
|
(collect-ready-work (cons (transaction-value txn) work) rest))
|
||||||
|
(values (reverse work) manager)))
|
||||||
|
|
Loading…
Reference in New Issue