117 lines
5.0 KiB
Scheme
117 lines
5.0 KiB
Scheme
(module timeouts mzscheme
|
|
(require (lib "class.ss")
|
|
(lib "plt-match.ss"))
|
|
(require "manager.ss")
|
|
(require "../timer.ss")
|
|
(provide timeout-manager%)
|
|
|
|
;; Utility
|
|
(define (make-counter)
|
|
(let ([i 0])
|
|
(lambda ()
|
|
(set! i (add1 i))
|
|
i)))
|
|
|
|
(define timeout-manager%
|
|
(class* object% (manager<%>)
|
|
(init-field instance-expiration-handler
|
|
instance-timer-length
|
|
continuation-timer-length)
|
|
(public create-instance
|
|
adjust-timeout!
|
|
instance-lookup-data
|
|
clear-continuations!
|
|
continuation-store!
|
|
continuation-lookup)
|
|
|
|
;; Instances
|
|
(define instances (make-hash-table))
|
|
(define next-instance-id (make-counter))
|
|
|
|
(define-struct instance (data k-table timer))
|
|
(define (create-instance data expire-fn)
|
|
(define instance-id (next-instance-id))
|
|
(hash-table-put! instances
|
|
instance-id
|
|
(make-instance data
|
|
(create-k-table)
|
|
(start-timer instance-timer-length
|
|
(lambda ()
|
|
(expire-fn)
|
|
(hash-table-remove! instances instance-id)))))
|
|
instance-id)
|
|
(define (adjust-timeout! instance-id secs)
|
|
(reset-timer! (instance-timer (instance-lookup instance-id))
|
|
secs))
|
|
|
|
(define (instance-lookup instance-id)
|
|
(define instance
|
|
(hash-table-get instances instance-id
|
|
(lambda ()
|
|
(raise (make-exn:fail:servlet-manager:no-instance
|
|
(string->immutable-string
|
|
(format "No instance for id: ~a" instance-id))
|
|
(current-continuation-marks)
|
|
instance-expiration-handler)))))
|
|
(increment-timer! (instance-timer instance)
|
|
instance-timer-length)
|
|
instance)
|
|
|
|
;; Continuation table
|
|
(define-struct k-table (next-id-fn htable))
|
|
(define (create-k-table)
|
|
(make-k-table (make-counter) (make-hash-table)))
|
|
|
|
;; Interface
|
|
(define (instance-lookup-data instance-id)
|
|
(instance-data (instance-lookup instance-id)))
|
|
|
|
(define (clear-continuations! instance-id)
|
|
(match (instance-lookup instance-id)
|
|
[(struct instance (data (and k-table (struct k-table (next-id-fn htable))) instance-timer))
|
|
(hash-table-for-each
|
|
htable
|
|
(match-lambda*
|
|
[(list k-id (list salt k expiration-handler k-timer))
|
|
(hash-table-put! htable k-id
|
|
(list salt #f expiration-handler k-timer))]))]))
|
|
|
|
(define (continuation-store! instance-id k expiration-handler)
|
|
(match (instance-lookup instance-id)
|
|
[(struct instance (data (struct k-table (next-id-fn htable)) instance-timer))
|
|
(define k-id (next-id-fn))
|
|
(define salt (random 100000000))
|
|
(hash-table-put! htable
|
|
k-id
|
|
(list salt k expiration-handler
|
|
(start-timer continuation-timer-length
|
|
(lambda ()
|
|
(hash-table-put! htable k-id
|
|
(list salt #f expiration-handler
|
|
(start-timer 0 void)))))))
|
|
(list k-id salt)]))
|
|
(define (continuation-lookup instance-id a-k-id a-salt)
|
|
(match (instance-lookup instance-id)
|
|
[(struct instance (data (struct k-table (next-id-fn htable)) instance-timer))
|
|
(match
|
|
(hash-table-get htable a-k-id
|
|
(lambda ()
|
|
(raise (make-exn:fail:servlet-manager:no-continuation
|
|
(string->immutable-string
|
|
(format "No continuation for id: ~a" a-k-id))
|
|
(current-continuation-marks)
|
|
instance-expiration-handler))))
|
|
[(list salt k expiration-handler k-timer)
|
|
(increment-timer! k-timer
|
|
continuation-timer-length)
|
|
(if (or (not (eq? salt a-salt))
|
|
(not k))
|
|
(raise (make-exn:fail:servlet-manager:no-continuation
|
|
(string->immutable-string
|
|
(format "No continuation for id: ~a" a-k-id))
|
|
(current-continuation-marks)
|
|
expiration-handler))
|
|
k)])]))
|
|
|
|
(super-new))))
|