#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")
(require "conversation.rkt")
(require racket/class)

(provide make-transaction-manager

	 transaction-manager?
	 open-transaction
	 close-transaction!
	 transaction-available?
	 dequeue-transaction

	 transaction?
	 transaction-context
	 transaction-value

	 room-rpc
	 room-rpc-finish)

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

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