General RPC-management utilities.

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))
 

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)))