Reorder out-of-order request responses.
This commit is contained in:
parent
125e19f41a
commit
1ab7cecf97
|
@ -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))
|
|
@ -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)
|
||||
)
|
Loading…
Reference in New Issue