(module resume-unit mzscheme (require (lib "unitsig.ss") (lib "servlet-sig.ss" "web-server")) (provide resume@ resume^) (define-signature resume^ (set-resume-point! ; user -> (union #f tst) log-out! ; user -> void clear-resume-table! ; -> void send/suspend-to-user ; (string -> response), user -> request send/finish-to-user ; response, user -> void send/forward-to-user ; (string -> response), user -> request send/back-to-user ; response, user -> void resume ; user [tst] -> #f )) ;; ------------------------------------------------------------ ;; THE RESUME TABLE ;; It must be outside the unit because the unit gets instantiated ;; once per servlet instance (in the case of unit servlets) but ;; the table must be instantiated only once per instantiation of ;; the servlet itself ;; *R* : USER -o> continuation ;; Maps user names to the continuation representing the farthest ;; point the user has reached in this web interaction (define *R* (make-hash-table 'equal)) ;; using a mutex lock here rather than channels because it seems ;; slightly simpler for this minimal amount of synchronization (define *R-lock* (make-semaphore 1)) ;; ------------------------------------------------------------ ;; THE RESUME@ UNIT ;; Defines the resume primitives. (define resume@ (unit/sig resume^ (import servlet^) ;; set-resume-point! : USER -> tst ;; sets the given resume point and returns #f. When this point is resumed to, ;; returns #t by default or anything the program provides as an extra optional ;; argument to resume. (define (set-resume-point! user) (let/cc k (begin (call-with-semaphore *R-lock* (λ () (hash-table-put! *R* user k))) #f))) ;; log-out! : -> void ;; get rid of a user's entry in the user table (define (log-out! user) (call-with-semaphore *R-lock* (λ () (hash-table-remove! *R* user))) (void)) ;; clear-user-table! : -> void ;; clear the entire user table (define (clear-resume-table!) (call-with-semaphore *R-lock* (λ () (set! *R* (make-hash-table 'equal)))) (void)) ;; send-to-user* : (X -> Y) -> X user -> Y ;; abstraction over the pattern found in all the send/*-to-user functions below (define ((send-to-user* sender) response user) (set-resume-point! user) (sender response)) ;; implementations of the "-to-user" versions of the web primitives (define send/suspend-to-user (send-to-user* send/suspend)) (define send/finish-to-user (send-to-user* send/finish)) (define send/forward-to-user (send-to-user* send/forward)) (define send/back-to-user (send-to-user* send/back)) ;; resume : user [tst] -> #f ;; if the user has a current session, this function ;; does not return and instead throws to the continuation ;; representing that session. Otherwise returns false. (define resume (case-lambda [(user) (resume user #t)] [(user resume-value) (let ((k (call-with-semaphore *R-lock* (λ () (hash-table-get *R* user (lambda () #f)))))) (if k (k resume-value) #f))])))))