suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

s/s/d tail call optimization

Browse Source 
svn: r1389
This commit is contained in:
Jay McCarthy 2005-11-24 06:05:59 +00:00
parent 06c60a7f18
commit c478a29110
1 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/web-server/servlet.ss
View File

@ -8,7 +8,7 @@
"servlet-helpers.ss" "servlet-helpers.ss"
"timer.ss" "timer.ss"
"web-cells.ss") "web-cells.ss")
;; ************************************************************ ;; ************************************************************
;; HELPERS ;; HELPERS
@ -20,8 +20,8 @@
(if (procedure? (exn:invalid-xexpr-code exn)) (if (procedure? (exn:invalid-xexpr-code exn))
#t #t
(begin ((error-display-handler) (exn-message exn) exn) (begin ((error-display-handler) (exn-message exn) exn)
#f))))) #f)))))
;; replace-procedures : (proc -> url) xexpr/callbacks? -> xexpr? ;; replace-procedures : (proc -> url) xexpr/callbacks? -> xexpr?
;; Change procedures to the send/suspend of a k-url ;; Change procedures to the send/suspend of a k-url
(define (xexpr/callback->xexpr p->a p-exp) (define (xexpr/callback->xexpr p->a p-exp)
@ -66,13 +66,13 @@
;; current-servlet-continuation-expiration-handler : request -> response ;; current-servlet-continuation-expiration-handler : request -> response
(define current-servlet-continuation-expiration-handler (define current-servlet-continuation-expiration-handler
(make-parameter #f)) (make-parameter #f))
;; adjust-timeout! : sec -> void ;; adjust-timeout! : sec -> void
;; adjust the timeout on the servlet ;; adjust the timeout on the servlet
(define (adjust-timeout! secs) (define (adjust-timeout! secs)
(reset-timer (servlet-instance-timer (get-current-servlet-instance)) (reset-timer (servlet-instance-timer (get-current-servlet-instance))
secs)) secs))
;; ext:clear-continuations! -> void ;; ext:clear-continuations! -> void
(define (clear-continuation-table!) (define (clear-continuation-table!)
(clear-continuations! (get-current-servlet-instance))) (clear-continuations! (get-current-servlet-instance)))
@ -83,7 +83,7 @@
(let ([ctxt (servlet-instance-context (get-current-servlet-instance))]) (let ([ctxt (servlet-instance-context (get-current-servlet-instance))])
(output-response (execution-context-connection ctxt) resp) (output-response (execution-context-connection ctxt) resp)
((execution-context-suspend ctxt)))) ((execution-context-suspend ctxt))))
;; send/finish: response -> void ;; send/finish: response -> void
;; send a response and clear the continuation table ;; send a response and clear the continuation table
(define (send/finish resp) (define (send/finish resp)
@ -94,7 +94,7 @@
; In the future, we should use the servlet's specific default-timeout ; In the future, we should use the servlet's specific default-timeout
(adjust-timeout! 10) (adjust-timeout! 10)
(send/back resp)) (send/back resp))
;; send/suspend: (url -> response) [(request -> response)] -> request ;; send/suspend: (url -> response) [(request -> response)] -> request
;; send a response and apply the continuation to the next request ;; send a response and apply the continuation to the next request
(define send/suspend (define send/suspend
@ -110,7 +110,7 @@
[response (response-generator k-url)]) [response (response-generator k-url)])
(output-response (execution-context-connection ctxt) response) (output-response (execution-context-connection ctxt) response)
((execution-context-suspend ctxt))))))) ((execution-context-suspend ctxt)))))))
;; send/forward: (url -> response) [(request -> response)] -> request ;; send/forward: (url -> response) [(request -> response)] -> request
;; clear the continuation table, then behave like send/suspend ;; clear the continuation table, then behave like send/suspend
(define send/forward (define send/forward
@ -122,11 +122,18 @@
;; send/back a response generated from a procedure that may convert ;; send/back a response generated from a procedure that may convert
;; procedures to continuation urls ;; procedures to continuation urls
(define (send/suspend/dispatch response-generator) (define (send/suspend/dispatch response-generator)
(let/ec k0 ; This restores the tail position.
(send/back ; Note: Herman's syntactic strategy would fail without the new-request capture.
(response-generator ; (Moving this to the tail-position is not possible anyway, by the way.)
(opt-lambda (proc [expiration-handler (current-servlet-continuation-expiration-handler)]) (let ([thunk
(let/ec k1 (k0 (proc (send/suspend k1 expiration-handler))))))))) (let/ec k0
(send/back
(response-generator
(opt-lambda (proc [expiration-handler (current-servlet-continuation-expiration-handler)])
(let/ec k1
(let ([new-request (send/suspend k1 expiration-handler)])
(k0 (lambda () (proc new-request)))))))))])
(thunk)))
;; send/suspend/callback : xexpr/callback? -> void ;; send/suspend/callback : xexpr/callback? -> void
;; send/back a response with callbacks in it; send/suspend those callbacks. ;; send/back a response with callbacks in it; send/suspend those callbacks.