General RPC-management utilities.
This commit is contained in:
parent
0af0e9ffa3
commit
204edd2679
|
@ -24,8 +24,7 @@
|
|||
(struct-out credit)
|
||||
|
||||
(struct-out rpc-request)
|
||||
(struct-out rpc-reply)
|
||||
(struct-out rpc-error)
|
||||
(struct-out rpc-reply) ;; error is a kind of reply; crashes are detected via disconnection
|
||||
)
|
||||
|
||||
(struct arrived (who) #:prefab) ;; someone arrived
|
||||
|
@ -36,7 +35,6 @@
|
|||
|
||||
(struct rpc-request (reply-to id body) #:prefab)
|
||||
(struct rpc-reply (id body) #:prefab)
|
||||
(struct rpc-error (id reason) #:prefab)
|
||||
|
||||
(struct room (name ch))
|
||||
|
||||
|
|
|
@ -11,6 +11,8 @@
|
|||
;; no. 8, pp. 274-279.
|
||||
|
||||
(require "functional-queue.rkt")
|
||||
(require "conversation.rkt")
|
||||
(require racket/class)
|
||||
|
||||
(provide make-transaction-manager
|
||||
|
||||
|
@ -22,7 +24,10 @@
|
|||
|
||||
transaction?
|
||||
transaction-context
|
||||
transaction-value)
|
||||
transaction-value
|
||||
|
||||
room-rpc
|
||||
room-rpc-finish)
|
||||
|
||||
(struct transaction-manager (queue) #:transparent)
|
||||
|
||||
|
@ -58,3 +63,18 @@
|
|||
(when (not (transaction-ready? txn))
|
||||
(error 'transaction-value "Attempt to extract value from unclosed transaction"))
|
||||
(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