From 1ab7cecf97dd0c5b207fa585c7c63780c3072e4d Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Mon, 24 Oct 2011 18:34:47 -0400
Subject: [PATCH] Reorder out-of-order request responses.

---
 ordered-rpc.rkt      | 60 ++++++++++++++++++++++++++++++++++++++++++++
 test-ordered-rpc.rkt | 30 ++++++++++++++++++++++
 2 files changed, 90 insertions(+)
 create mode 100644 ordered-rpc.rkt
 create mode 100644 test-ordered-rpc.rkt

diff --git a/ordered-rpc.rkt b/ordered-rpc.rkt
new file mode 100644
index 0000000..6465c36
--- /dev/null
+++ b/ordered-rpc.rkt
@@ -0,0 +1,60 @@
+#lang racket/base
+;; Issue requests in order, process them in any order (or in
+;; parallel), reassemble the ordering at the end.
+
+;; What I'm doing here reminded me of the signal-notification
+;; mechanism from [1], but is actually quite different.
+;;
+;; [1] O. Shivers, "Automatic management of operating-system
+;; resources," in Proceedings of the Second ACM SIGPLAN International
+;; Conference on Functional Programming (ICFP '97), 1997, vol. 32,
+;; no. 8, pp. 274-279.
+
+(require "functional-queue.rkt")
+
+(provide make-transaction-manager
+
+	 transaction-manager?
+	 open-transaction
+	 close-transaction!
+	 transaction-available?
+	 dequeue-transaction
+
+	 transaction?
+	 transaction-context
+	 transaction-value)
+
+(struct transaction-manager (queue) #:transparent)
+
+(struct transaction (context
+		     [value* #:mutable]
+		     [ready? #:mutable]))
+
+(define (make-transaction-manager)
+  (transaction-manager (make-queue)))
+
+(define (open-transaction manager context)
+  (define txn (transaction context #f #f))
+  (values txn (transaction-manager (enqueue (transaction-manager-queue manager) txn))))
+
+(define (close-transaction! txn value)
+  (when (transaction-ready? txn)
+    (error 'close-transaction! "Attempt to close previously-closed transaction"))
+  (set-transaction-value*! txn value)
+  (set-transaction-ready?! txn #t)
+  value)
+
+(define (transaction-available? manager)
+  (if (queue-empty? (transaction-manager-queue manager))
+      #f
+      (let-values (((txn rest) (dequeue (transaction-manager-queue manager))))
+	(transaction-ready? txn))))
+
+(define (dequeue-transaction manager)
+  (let-values (((txn rest) (dequeue (transaction-manager-queue manager))))
+    (values txn (transaction-manager rest))))
+
+(define (transaction-value txn)
+  (when (not (transaction-ready? txn))
+    (error 'transaction-value "Attempt to extract value from unclosed transaction"))
+  (transaction-value* txn))
diff --git a/test-ordered-rpc.rkt b/test-ordered-rpc.rkt
new file mode 100644
index 0000000..fe6ea69
--- /dev/null
+++ b/test-ordered-rpc.rkt
@@ -0,0 +1,30 @@
+#lang racket/base
+
+(require "ordered-rpc.rkt")
+(require rackunit)
+
+(let ((tm0 (make-transaction-manager)))
+  (define-values (t1 tm1) (open-transaction tm0 'a))
+  (define-values (t2 tm2) (open-transaction tm1 'b))
+  (define-values (t3 tm3) (open-transaction tm2 'c))
+
+  (check-equal? (transaction-available? tm3) #f)
+  (close-transaction! t2 'second)
+  (check-equal? (transaction-available? tm3) #f)
+  (close-transaction! t1 'first)
+  (check-equal? (transaction-available? tm3) #t)
+
+  (define-values (v1 tm4) (dequeue-transaction tm3))
+  (check-equal? (transaction-context v1) 'a)
+  (check-equal? (transaction-value v1) 'first)
+  (check-equal? (transaction-available? tm4) #t)
+
+  (define-values (v2 tm5) (dequeue-transaction tm4))
+
+  (check-equal? (transaction-available? tm5) #f)
+  (close-transaction! t3 'third)
+  (check-equal? (transaction-available? tm5) #t)
+
+  (define-values (v3 tm6) (dequeue-transaction tm5))
+  (check-equal? (transaction-available? tm6) #f)
+  )