diff --git a/conversation.rkt b/conversation.rkt index cfa9bc4..2887bfe 100644 --- a/conversation.rkt +++ b/conversation.rkt @@ -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)) diff --git a/ordered-rpc.rkt b/ordered-rpc.rkt index 6465c36..aec7b22 100644 --- a/ordered-rpc.rkt +++ b/ordered-rpc.rkt @@ -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)))