compat

svn: r13922

collects/tests/web-server/lang-test.ss

@@ -200,12 +200,12 @@
    
    ;; ****************************************
    ;; ****************************************
-   ;; TESTS INVOLVING send/suspend
+   ;; TESTS INVOLVING call-with-serializable-current-continuation
    (test-suite
-    "Tests Involving send/suspend"
+    "Tests Involving call-with-serializable-current-continuation"
     
     (test-case
-     "curried add with send/suspend"
+     "curried add with call-with-serializable-current-continuation"
      (let ([table-01-eval
             (make-module-eval
              (module table01 mzscheme
@@ -227,7 +227,7 @@
            
            (define (gn which)
              (cadr
-              (send/suspend
+              (call-with-serializable-current-continuation
                (lambda (k)
                  (let ([ignore (printf "Please send the ~a number.~n" which)])
                    (store-k k))))))
@@ -248,7 +248,7 @@
          (check-true (zero? (table-01-eval `(dispatch lookup-k '(,third-key 7))))))))
     
     (test-case
-     "curried with send/suspend and serializaztion"
+     "curried with call-with-serializable-current-continuation and serializaztion"
      
      (let-values ([(test-m06.1)
                    (make-module-eval
@@ -256,7 +256,7 @@
                       (provide start)
                       (define (gn which)
                         (cadr
-                         (send/suspend
+                         (call-with-serializable-current-continuation
                           (lambda (k)
                             (let ([ignore (printf "Please send the ~a number.~n" which)])
                               k)))))
@@ -275,7 +275,7 @@
          (check-true (zero? (test-m06.1 `(dispatch ,the-dispatch (list ,third-key 7))))))))
     
     (test-case
-     "curried with send/suspend and serializaztion (keyword args)"
+     "curried with call-with-serializable-current-continuation and serializaztion (keyword args)"
      
      (let-values ([(test-m06.2)
                    (make-module-eval
@@ -283,7 +283,7 @@
                       (provide start)
                       (define (gn #:page which)
                         (cadr
-                         (send/suspend
+                         (call-with-serializable-current-continuation
                           (lambda (k)
                             (let ([ignore (printf "Please send the ~a number.~n" which)])
                               k)))))
@@ -373,14 +373,14 @@
        (check-false (test-m07 '(dispatch-start start 7)))))
     
     (test-case
-     "send/suspend on rhs of letrec binding forms"
+     "call-with-serializable-current-continuation on rhs of letrec binding forms"
      (let-values ([(test-m08)
                    (make-module-eval
                     (module m08 (lib "lang.ss" "web-server")
                       (provide start)
                       (define (gn which)
                         (cadr
-                         (send/suspend
+                         (call-with-serializable-current-continuation
                           (lambda (k)
                             (let ([ignore (printf "Please send the ~a number.~n" which)])
                               k)))))
@@ -483,7 +483,7 @@
        (check = 2 (ta-eval '(dispatch-start start 1)))))
     
     (test-case
-     "attempt send/suspend from standard call to map"
+     "attempt call-with-serializable-current-continuation from standard call to map"
      
      (let-values ([(m13-eval)
                    (make-module-eval
@@ -491,7 +491,7 @@
                       (provide start)
                       (define (start initial)
                         (map
-                         (lambda (n) (send/suspend
+                         (lambda (n) (call-with-serializable-current-continuation
                                       (lambda (k)
                                         (let ([ignore (printf "n = ~s~n" n)])
                                           k))))
@@ -500,7 +500,7 @@
                     (lambda () (m13-eval '(dispatch-start start 'foo)))))))
     
     (test-case
-     "attempt send/suspend from tail position of untranslated procedure"
+     "attempt call-with-serializable-current-continuation from tail position of untranslated procedure"
      
      (let-values ([(ta-eval)
                    (make-module-eval
@@ -517,7 +517,7 @@
                      (+ 1 (tail-apply
                            (lambda (n)
                              (cadr
-                              (send/suspend
+                              (call-with-serializable-current-continuation
                                (lambda (k)
                                  (let ([ignore (printf "n = ~s~n" n)])
                                    k))))) 7)))))

collects/tests/web-server/lang/web-param-test.ss

@@ -41,7 +41,7 @@
                       (define (start ignore)
                         (web-parameterize ([first 1]
                                            [second 2])
-                                          (send/suspend (lambda (k) k))
+                                          (call-with-serializable-current-continuation (lambda (k) k))
                                           (+ (first) (second))))))])
        (let ([first-key (meval '(dispatch-start start #f))])
          (check = 3 (meval `(dispatch ,the-dispatch (list ,first-key #f))))))))))

collects/web-server/default-web-root/htdocs/lang-servlets/add06.ss

@@ -5,7 +5,7 @@
 ;; get-number-from-user: string -> number
 ;; ask the user for a number
 (define (gn msg)
-  (send/suspend/dispatch
+  (send/suspend/url/dispatch
    (lambda (embed/url)
      `(hmtl (head (title ,(format "Get ~a number" msg)))
             (body

collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss

@@ -4,7 +4,7 @@
 
 (define (gn which)
   (cadr
-   (send/suspend
+   (call-with-serializable-current-continuation
     (lambda (k)
       (let ([ignore (printf "Please send the ~a number.~n" which)])
         k)))))

collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss

@@ -4,7 +4,7 @@
 
 (define (gn which)
   (cadr
-   (send/suspend
+   (call-with-serializable-current-continuation
     (lambda (k)
       (let ([ignore (printf "Please send the ~a number.~n" which)])
         k)))))

collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss

@@ -11,7 +11,7 @@
   (define include1 (include-counter counter1))
   (define include2 (include-counter counter2))
   ; counter1 and counter2 may have been modified
-  (send/suspend/dispatch
+  (send/suspend/url/dispatch
    (lambda (embed/url)
      ; The frame (ref) must have been captured, any changes to web-cells after this will be lost
      `(html 

collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss

@@ -5,7 +5,7 @@
 (define (start initial-request)
   (define counter1 0)
   (define counter2 0)
-  (send/suspend/dispatch
+  (send/suspend/url/dispatch
    (lambda (embed/url)
      (let*-values ([(inc1 next-counter1 next-counter2) (include-counter counter1 counter2 embed/url)]
                    [(inc2 next-counter2 next-counter1) (include-counter next-counter2 next-counter1 embed/url)])

collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss

@@ -10,7 +10,7 @@
   (define include1 (include-counter counter1))
   (define include2 (include-counter counter2))
   ; counter1 and counter2 may have been modified
-  (send/suspend/dispatch
+  (send/suspend/url/dispatch
    (lambda (embed/url)
      ; The frame (ref) must have been captured, any changes to web-cells after this will be lost
      `(html 

collects/web-server/lang/abort-resume.ss

@@ -116,7 +116,7 @@
 
 ;; send/suspend: (continuation -> response) -> request
 ;; produce the current response and wait for the next request
-(define (send/suspend response-maker)
+(define (call-with-serializable-current-continuation response-maker)
   (with-continuation-mark safe-call? '(#t send/suspend)
     (let ([current-marks (activation-record-list)]
           [wcs (capture-web-cell-set)])
@@ -189,4 +189,4 @@
 (provide
  ;; "SERVLET" INTERFACE
  ; A contract would interfere with the safe-call? key
- send/suspend)
+ call-with-serializable-current-continuation)

collects/web-server/lang/web.ss

@@ -17,9 +17,11 @@
  initialize-servlet 
  
  ;; Servlet Interface
+ send/suspend
+ send/suspend/dispatch
  send/suspend/hidden
  send/suspend/url
- send/suspend/dispatch)
+ send/suspend/url/dispatch)
 
 (provide/contract
  [make-stateless-servlet
@@ -34,8 +36,8 @@
    ;; Servlet Interface
    [send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
    [send/suspend/url ((url? . -> . response/c) . -> . request?)]
-   [send/suspend/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
+   [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
-                           . -> . any/c)])
+                               . -> . any/c)])
 
 ;; initial-servlet : (request -> response) -> (request -> response/c)
 (define (initialize-servlet start)
@@ -55,7 +57,7 @@
 ;; send/suspend/hidden: (url input-field -> response) -> request
 ;; like send/suspend except the continuation is encoded in a hidden field
 (define (send/suspend/hidden page-maker)
-  (send/suspend
+  (call-with-serializable-current-continuation
    (lambda (k)
      (define stuffer (stateless-servlet-stuffer (current-servlet)))
      (define p-cont ((stuffer-in stuffer) k))
@@ -66,7 +68,7 @@
 ;; send/suspend/url: (url -> response) -> request
 ;; like send/suspend except the continuation is encoded in the url
 (define (send/suspend/url page-maker)
-  (send/suspend
+  (call-with-serializable-current-continuation
    (lambda (k)
      (define stuffer (stateless-servlet-stuffer (current-servlet)))
      (page-maker
@@ -74,15 +76,31 @@
                  (request-uri (execution-context-request (current-execution-context)))
                  k)))))
 
+(define (send/suspend page-maker)
+  (send/suspend/url
+   (lambda (k-url)
+     (page-maker (url->string k-url)))))
+
 (define-closure embed/url (proc) (k)
   (stuff-url (stateless-servlet-stuffer (current-servlet))
              (request-uri (execution-context-request (current-execution-context)))
              (kont-append-fun k proc)))
-(define (send/suspend/dispatch response-generator)
+(define (send/suspend/url/dispatch response-generator)
-  (send/suspend
+  (call-with-serializable-current-continuation
    (lambda (k)
      (response-generator (make-embed/url (lambda () k))))))
 
+; XXX Uncopy&paste
+(define-closure embed (proc) (k)
+  (url->string
+   (stuff-url (stateless-servlet-stuffer (current-servlet))
+              (request-uri (execution-context-request (current-execution-context)))
+              (kont-append-fun k proc))))
+(define (send/suspend/dispatch response-generator)
+  (call-with-serializable-current-continuation
+   (lambda (k)
+     (response-generator (make-embed (lambda () k))))))
+
 ;; request->continuation: req -> continuation
 ;; decode the continuation from the hidden field of a request
 (define (request->continuation req)

collects/web-server/scribblings/lang.scrbl

@@ -14,7 +14,7 @@
 @(require (for-label web-server/lang/abort-resume))
 @defmodule[web-server/lang/abort-resume]{
 
-@defproc[(send/suspend [response-generator (continuation? . -> . any)])
+@defproc[(call-with-serializable-current-continuation [response-generator (continuation? . -> . any)])
          any]{
  Captures the current continuation in a serializable way and calls @scheme[response-generator] with it, returning the result.
 }
@@ -33,6 +33,11 @@
  the response to the client. If the URL is invoked
  the request is returned to this continuation.
 }
+                  
+@defproc[(send/suspend [response-generator (string? . -> . response/c)])
+         request?]{
+ Like @scheme[send/suspend/url] but with a string URL representation.
+}
 
 @defproc[(send/suspend/hidden [response-generator (url? xexpr/c . -> . response/c)])
          request?]{
@@ -44,13 +49,18 @@
  the request is returned to this continuation.
 }
 
-@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)])
+@defproc[(send/suspend/url/dispatch [make-response (((request? . -> . any) . -> . url?) . -> . response/c)])
-         any/c]{
+         any]{
  Calls @scheme[make-response] with a function that, when called with a procedure from
  @scheme[request?] to @scheme[any/c] will generate a URL, that when invoked will call
  the function with the @scheme[request?] object and return the result to the caller of
  @scheme[send/suspend/dispatch].
 }
+               
+@defproc[(send/suspend/dispatch [make-response (((request? . -> . any) . -> . string?) . -> . response/c)])
+         request?]{
+ Like @scheme[send/suspend/url/dispatch] but with a string URL representation.
+}
 
 @deftogether[(
 @defproc[(redirect/get) request?]

collects/web-server/scribblings/web.scrbl

@@ -4,7 +4,8 @@
 @title[#:tag "web.ss"]{Web Interaction}
 @(require (for-label web-server/servlet/web
                      web-server/servlet/servlet-structs
-                     web-server/http))
+                     web-server/http
+                     net/url))
 
 @defmodule[web-server/servlet/web]{The
 @schememodname[web-server/servlet/web] library provides the primary
@@ -25,8 +26,7 @@ functions of interest for the servlet developer.
  ]
 }
 
-@defproc[(send/suspend [make-response response-generator/c]
+@defproc[(send/suspend [make-response (string? . -> . response/c)])
-                       [exp expiration-handler/c (current-servlet-continuation-expiration-handler)])
          request?]{
  Captures the current continuation, stores it with @scheme[exp] as the expiration
  handler, and binds it to a URL. @scheme[make-response] is called with this URL and
@@ -50,8 +50,13 @@ functions of interest for the servlet developer.
  Thus, the request will be ``returned'' from @scheme[send/suspend] to the continuation of this call.
 }
                   
-@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)])
+@defproc[(send/suspend/url [make-response (url? . -> . response/c)])
-         any/c]{
+         request?]{
+ Like @scheme[send/suspend] but with a URL struct.
+}
+                  
+@defproc[(send/suspend/dispatch [make-response (((request? . -> . any) . -> . string?) . -> . response/c)])
+         any]{
  Calls @scheme[make-response] with a function (@scheme[embed/url]) that, when called with a procedure from
  @scheme[request?] to @scheme[any/c] will generate a URL, that when invoked will call
  the function with the @scheme[request?] object and return the result to the caller of
@@ -110,9 +115,13 @@ functions of interest for the servlet developer.
                  "+")))))))
   ]
 }
+             
+@defproc[(send/suspend/url/dispatch [make-response (((request? . -> . any) . -> . url?) . -> . response/c)])
+         any]{
+ Like @scheme[send/suspend/dispatch], but with a URL struct.
+}
 
-@defproc[(send/forward [make-response response-generator/c]
+@defproc[(send/forward [make-response (string? . -> . response/c)])
-                       [exp expiration-handler/c (current-servlet-continuation-expiration-handler)])
          request?]{
  Calls @scheme[clear-continuation-table!], then @scheme[send/suspend].
        

collects/web-server/scribblings/writing.scrbl

@@ -18,6 +18,7 @@ There are two API sets provided by the Web Server. One is for standard servlets,
 
 This API provides: 
 @itemize{
+         @item{@schememodname[net/url],}
          @item{@schememodname[web-server/servlet/web-cells],}
          @item{@schememodname[web-server/dispatch],}
          @item{@schememodname[web-server/http/bindings],}
@@ -79,7 +80,7 @@ Example: @schemeblock[(lambda (req)
 }
 
 @defthing[embed/url/c contract?]{
-Equivalent to @scheme[(((request? . -> . any/c)) (expiration-handler/c) . opt-> . string?)].
+Equivalent to @scheme[((request? . -> . any) . -> . string?)].
 
 This is what @scheme[send/suspend/dispatch] gives to its function argument.
 }

collects/web-server/servlet.ss

@@ -1,11 +1,13 @@
 #lang scheme/base
-(require web-server/servlet/web-cells
+(require net/url
+         web-server/servlet/web-cells         
          web-server/http/bindings
          web-server/http
          web-server/dispatch
          web-server/servlet/servlet-structs
          web-server/servlet/web)
-(provide (all-from-out web-server/servlet/web-cells
+(provide (all-from-out net/url
+                       web-server/servlet/web-cells
                        web-server/http/bindings
                        web-server/dispatch
                        web-server/http

collects/web-server/servlet/servlet-structs.ss

@@ -13,7 +13,7 @@
         (request? . -> . response/c)))
 
 (define embed/url/c
-  (((request? . -> . any/c)) (expiration-handler/c) . ->* . string?))
+  ((request? . -> . any/c) . -> . string?))
 
 (provide/contract
  [response-generator/c contract?]

collects/web-server/servlet/web.ss

@@ -42,9 +42,11 @@
  [clear-continuation-table! (-> void?)]
  [send/back (response/c . -> . void?)]
  [send/finish (response/c . -> . void?)]
- [send/suspend ((response-generator/c) (expiration-handler/c) . ->* . request?)]
+ [send/forward (response-generator/c . -> . request?)]
- [send/forward ((response-generator/c) (expiration-handler/c) . ->* . request?)]
+ [send/suspend (response-generator/c . -> . request?)]
- [send/suspend/dispatch ((embed/url/c . -> . response/c) . -> . any/c)])
+ [send/suspend/dispatch ((embed/url/c . -> . response/c) . -> . any/c)]
+ [send/suspend/url ((url? . -> . response/c) . -> . request?)]
+ [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)])
 
 ;; ************************************************************
 ;; EXPORTS
@@ -73,10 +75,9 @@
   (clear-continuation-table!)
   (send/back resp))
 
-;; send/suspend: (url -> response) [(request -> response)] -> request
+;; send/suspend: (url -> response) -> request
 ;; send a response and apply the continuation to the next request
-(define (send/suspend response-generator
+(define (send/suspend response-generator)
-                      [expiration-handler (current-servlet-continuation-expiration-handler)])
   (define wcs (capture-web-cell-set))
   (begin0
     (call-with-composable-continuation
@@ -86,7 +87,7 @@
        (define k-embedding ((manager-continuation-store! (current-servlet-manager))
                             instance-id
                             (make-custodian-box (current-custodian) k)
-                            expiration-handler))
+                            (current-servlet-continuation-expiration-handler)))
        (define k-url (embed-ids 
                       (list* instance-id k-embedding)
                       (request-uri (execution-context-request ctxt))))
@@ -94,12 +95,16 @@
      servlet-prompt)
     (restore-web-cell-set! wcs)))
 
+(define (send/suspend/url response-generator)
+  (send/suspend
+   (lambda (k-url)
+     (response-generator (string->url k-url)))))
+
 ;; send/forward: (url -> response) [(request -> response)] -> request
 ;; clear the continuation table, then behave like send/suspend
-(define (send/forward response-generator
+(define (send/forward response-generator)
-                      [expiration-handler (current-servlet-continuation-expiration-handler)])
   (clear-continuation-table!)
-  (send/suspend response-generator expiration-handler))
+  (send/suspend response-generator))
 
 ;; send/suspend/dispatch : ((proc -> url) -> response) [(request -> response)] -> request
 ;; send/back a response generated from a procedure that may convert
@@ -113,17 +118,24 @@
           (lambda (k0)
             (send/back
              (response-generator
-              (lambda (proc [expiration-handler (current-servlet-continuation-expiration-handler)])
+              (lambda (proc)
                 (let/ec k1 
                   ; This makes the second continuation captured by send/suspend smaller
                   (call-with-continuation-prompt
                    (lambda ()
-                     (let ([new-request (send/suspend k1 expiration-handler)])
+                     (let ([new-request (send/suspend k1)])
                        (k0 (lambda () (proc new-request)))))
                    servlet-prompt))))))
           servlet-prompt)])
     (thunk)))
 
+(define (send/suspend/url/dispatch response-generator)
+  (send/suspend/dispatch
+   (lambda (embed/url)
+     (response-generator
+      (lambda (proc)
+        (string->url (embed/url proc)))))))
+
 ;; ************************************************************
 ;; HIGHER-LEVEL EXPORTS