From 72eefe8b2608b317ec357ff6dd86f39f6563973c Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Mon, 28 May 2007 22:03:20 +0000
Subject: [PATCH] Eliminating session and set! hairiness; Fixing anormalization
 bug re multiple values and begin0

svn: r6363
---
 .../dispatch-servlets2.ss                     |  39 +-
 .../web-server/prototype-web-server/lang.ss   |  11 +-
 .../prototype-web-server/lang/anormal.ss      |  25 +-
 .../prototype-web-server/lang/defun.ss        |  51 ++-
 .../prototype-web-server/lang/mark-lambda.ss  | 112 +++++
 .../prototype-web-server/lang/util.ss         |   2 +-
 .../private/abort-resume.ss                   |  38 +-
 .../prototype-web-server/private/session.ss   |  36 +-
 .../prototype-web-server/private/web.ss       |  37 +-
 .../tests/anormal-test.ss                     |  27 +-
 .../tests/certify-tests.ss                    |  21 +-
 .../prototype-web-server/tests/lang-tests.ss  | 412 +++++++++---------
 .../prototype-web-server/tests/param-tests.ss |  12 +-
 .../tests/persistent-close-tests.ss           |   2 +-
 .../tests/stuff-url-tests.ss                  |  29 +-
 .../prototype-web-server/tests/util.ss        |  24 +-
 16 files changed, 479 insertions(+), 399 deletions(-)
 create mode 100644 collects/web-server/prototype-web-server/lang/mark-lambda.ss

diff --git a/collects/web-server/prototype-web-server/dispatch-servlets2.ss b/collects/web-server/prototype-web-server/dispatch-servlets2.ss
index 63ab120e1a..e56e390d90 100644
--- a/collects/web-server/prototype-web-server/dispatch-servlets2.ss
+++ b/collects/web-server/prototype-web-server/dispatch-servlets2.ss
@@ -11,10 +11,8 @@
            (lib "plt-match.ss")
            (lib "dispatch.ss" "web-server" "dispatchers")
            (lib "session.ss" "web-server" "prototype-web-server" "private")
-           (only (lib "abort-resume.ss" "web-server" "prototype-web-server" "private")
-                 run-start)
            (only "private/web.ss"
-                 start-servlet)           
+                 initialize-servlet)           
            (lib "web-cells.ss" "web-server" "prototype-web-server" "lang-api")
            "private/utils.ss")
   
@@ -68,7 +66,7 @@
     ;; dispatch : connection request -> void
     (define (dispatch conn req)
       (adjust-connection-timeout! conn timeouts-servlet-connection)
-      ;; more here - make timeouts proportional to size of bindings
+      ;; XXX - make timeouts proportional to size of bindings
       (myprint "servlet-content-producer~n")
       (let ([meth (request-method req)])
         (if (eq? meth 'head)
@@ -112,7 +110,8 @@
                     (let ([module-name `(file ,(path->string a-path))])
                       (myprint "dynamic-require ...~n")
                       (let ([start (dynamic-require module-name 'start)])
-                        (run-start start-servlet start))))
+                        (set-session-servlet! ses
+                                              (initialize-servlet start)))))
                   (myprint "resume-session~n")
                   (resume-session (session-id ses)
                                   conn req)))
@@ -127,19 +126,19 @@
         (map path/param-path
              (url-path u)))
       (define ans
-      (let loop ([rp (abstract-url req)]
-                 [sp (abstract-url ses)])
-        (match sp
-          [(list)
-           #t]
-          [(list-rest s sp)
-           (match rp
-             [(list)
-              #f]
-             [(list-rest r rp)
-              (if (string=? s r)
-                  (loop rp sp)
-                  #f)])])))
+        (let loop ([rp (abstract-url req)]
+                   [sp (abstract-url ses)])
+          (match sp
+            [(list)
+             #t]
+            [(list-rest s sp)
+             (match rp
+               [(list)
+                #f]
+               [(list-rest r rp)
+                (if (string=? s r)
+                    (loop rp sp)
+                    #f)])])))
       (myprint "~S => ~S~n" `(same-servlet? ,(url->string req) ,(url->string ses)) ans)
       ans)
     
@@ -158,9 +157,9 @@
                                         conn
                                         (responders-servlet (request-uri req) the-exn)
                                         (request-method req)))])
-                      (myprint "session-handler ~S~n" (session-handler ses))
+                      (myprint "session-handler ~S~n" (session-servlet ses))
                       (output-response conn
-                                       ((session-handler ses) req))))
+                                       ((session-servlet ses) req))))
                   (begin-session conn req)))]
         [else
          (myprint "resume-session: Unknown ses~n")
diff --git a/collects/web-server/prototype-web-server/lang.ss b/collects/web-server/prototype-web-server/lang.ss
index 134a282f40..4db7466448 100644
--- a/collects/web-server/prototype-web-server/lang.ss
+++ b/collects/web-server/prototype-web-server/lang.ss
@@ -6,17 +6,24 @@
                       "lang/elim-letrec.ss"
                       "lang/anormal.ss"
                       "lang/elim-callcc.ss"
-                      "lang/defun.ss")
+                      "lang/defun.ss"
+                      "lang/mark-lambda.ss")
   (require "lang-api.ss")
   (provide (rename lang-module-begin #%module-begin))
   (provide (all-from "lang-api.ss"))
   
+  ; XXX We could optimize this process by marking user-provided lambdas and only defunctionalizing those.
+  
   (define-syntax lang-module-begin 
     (make-lang-module-begin 
      make-labeling
      (make-module-case/new-defs
       (make-define-case/new-defs
        (compose #;(lambda (stx) (values stx empty))
+                #;(lambda (stx)
+                  (parameterize ([defun? marked-lambda?])
+                    (defun stx)))
                 defun
                 elim-callcc
-                (make-anormal-term elim-letrec-term)))))))
\ No newline at end of file
+                (make-anormal-term elim-letrec-term)
+                #;mark-lambda))))))
\ No newline at end of file
diff --git a/collects/web-server/prototype-web-server/lang/anormal.ss b/collects/web-server/prototype-web-server/lang/anormal.ss
index da41cc01b8..9c5fe00365 100644
--- a/collects/web-server/prototype-web-server/lang/anormal.ss
+++ b/collects/web-server/prototype-web-server/lang/anormal.ss
@@ -1,11 +1,8 @@
 (module anormal mzscheme
   (require-for-template mzscheme)
   (require (lib "kerncase.ss" "syntax")
-           #;(lib "etc.ss")
            (lib "list.ss")
-           (lib "toplevel.ss" "syntax")
            (lib "plt-match.ss")
-           (lib "stx.ss" "syntax")
            "util.ss")
   (provide make-anormal-term)
   
@@ -43,20 +40,25 @@
          [(begin lbe)
           (anormal ctxt (syntax/loc stx lbe))]
          [(begin fbe be ...)
-          ; XXX Am I a bug?
           (anormal ctxt 
                    (syntax/loc stx 
-                     (let-values ([(throw-away) fbe])
-                       (begin be ...))))]
+                     (#%app call-with-values
+                            (lambda () fbe)
+                            (lambda throw-away
+                              (begin be ...)))))]
          [(begin0)
           (anormal ctxt (syntax/loc stx (#%app (#%top . void))))]
          [(begin0 lbe)
           (anormal ctxt (syntax/loc stx lbe))]
          [(begin0 fbe be ...)
-          (anormal ctxt 
-                   (syntax/loc stx 
-                     (let-values ([(save) fbe])
-                       (begin be ... save))))]
+          (let-values ([(save ref-to-save) (generate-formal 'save)])
+            (anormal ctxt 
+                     (quasisyntax/loc stx 
+                       (#%app call-with-values
+                              (lambda () fbe)
+                              (lambda #,save
+                                (begin be ... 
+                                       (#%app apply values #,ref-to-save)))))))]
          [(define-values (v ...) ve)
           (with-syntax ([ve (anormal-term #'ve)])
             (syntax/loc stx 
@@ -129,7 +131,8 @@
          [(letrec-syntaxes+values ([(sv ...) se] ...)
             ([(vv ...) ve] ...)
             be ...)
-          (raise-syntax-error 'anormal "XXX What do I do with letrec-syntaxes+values?" stx)]
+          (anormal ctxt
+                   (elim-letrec-term stx))]
          [(with-continuation-mark ke me be)
           (anormal
            (compose ctxt
diff --git a/collects/web-server/prototype-web-server/lang/defun.ss b/collects/web-server/prototype-web-server/lang/defun.ss
index cd6e4ad8bf..cb12a2a006 100644
--- a/collects/web-server/prototype-web-server/lang/defun.ss
+++ b/collects/web-server/prototype-web-server/lang/defun.ss
@@ -6,12 +6,15 @@
            "util.ss"
            "freevars.ss"
            "../private/closure.ss")
-  (provide defun)
+  (provide defun
+           defun?)
   
   ; make-new-clouse-label : (syntax -> syntax) syntax -> syntax
   (define (make-new-closure-label labeling stx)
     (labeling stx))
   
+  (define defun? (make-parameter (lambda _ #t)))
+  
   ; defun : syntax[1] -> (values syntax?[2] (listof syntax?)[3])
   ; defunctionalizes the first syntax, returning the second and the lifted lambdas [3]
   (define (defun stx)  
@@ -61,29 +64,35 @@
          [(lambda formals be ...)
           (let-values ([(nbes be-defs) (defun* (syntax->list #'(be ...)))])
             (with-syntax ([(nbe ...) nbes])
-              (let ([fvars (free-vars stx)])
-                (let-values ([(make-CLOSURE new-defs)
-                              (make-closure-definition-syntax 
-                               (make-new-closure-label (current-code-labeling) stx)
-                               fvars 
-                               (syntax/loc stx (lambda formals nbe ...)))])
-                  (values (if (empty? fvars)
-                              (quasisyntax/loc stx (#,make-CLOSURE))
-                              (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
-                          (append be-defs new-defs))))))]
+              (if ((defun?) stx)
+                  (let ([fvars (free-vars stx)])
+                    (let-values ([(make-CLOSURE new-defs)
+                                  (make-closure-definition-syntax 
+                                   (make-new-closure-label (current-code-labeling) stx)
+                                   fvars 
+                                   (syntax/loc stx (lambda formals nbe ...)))])
+                      (values (if (empty? fvars)
+                                  (quasisyntax/loc stx (#,make-CLOSURE))
+                                  (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
+                              (append be-defs new-defs))))
+                  (values (quasisyntax/loc stx (lambda formals nbe ...))
+                          be-defs))))]
          [(case-lambda [formals be ...] ...)       
           (let-values ([(nbes be-defs) (defun** (syntax->list #'((be ...) ...)))])
             (with-syntax ([((nbe ...) ...) nbes])
-              (let ([fvars (free-vars stx)])
-                (let-values ([(make-CLOSURE new-defs)
-                              (make-closure-definition-syntax 
-                               (make-new-closure-label (current-code-labeling) stx)
-                               fvars 
-                               (syntax/loc stx (case-lambda [formals nbe ...] ...)))])
-                  (values (if (empty? fvars)
-                              (quasisyntax/loc stx (#,make-CLOSURE))
-                              (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
-                          (append be-defs new-defs))))))]
+              (if ((defun?) stx)
+                  (let ([fvars (free-vars stx)])
+                    (let-values ([(make-CLOSURE new-defs)
+                                  (make-closure-definition-syntax 
+                                   (make-new-closure-label (current-code-labeling) stx)
+                                   fvars 
+                                   (syntax/loc stx (case-lambda [formals nbe ...] ...)))])
+                      (values (if (empty? fvars)
+                                  (quasisyntax/loc stx (#,make-CLOSURE))
+                                  (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
+                              (append be-defs new-defs))))
+                  (values (quasisyntax/loc stx (case-lambda [formals nbe ...] ...))
+                          be-defs))))]
          [(if te ce ae)
           (let-values ([(es defs) (defun* (syntax->list #'(te ce ae)))])
             (values (quasisyntax/loc stx (if #,@es))
diff --git a/collects/web-server/prototype-web-server/lang/mark-lambda.ss b/collects/web-server/prototype-web-server/lang/mark-lambda.ss
new file mode 100644
index 0000000000..f75344f473
--- /dev/null
+++ b/collects/web-server/prototype-web-server/lang/mark-lambda.ss
@@ -0,0 +1,112 @@
+(module mark-lambda mzscheme
+  (require-for-template mzscheme)
+  (require (lib "kerncase.ss" "syntax")
+           "util.ss")
+  (provide mark-lambda
+           marked-lambda?)
+  
+  (define lambda-key 'marked-lambda)
+  
+  (define (marked-lambda? stx)
+    (kernel-syntax-case stx #f
+      [(lambda formals be ...)
+       (syntax-property stx lambda-key)]
+      [(case-lambda [formals be ...] ...)
+       (syntax-property stx lambda-key)]
+      [_ #f]))
+  
+  (define (mark-lambda stx)  
+    (recertify
+     stx
+     (kernel-syntax-case 
+         stx #f 
+       [(begin be ...)
+        (with-syntax ([(be ...) (map mark-lambda (syntax->list #'(be ...)))])
+          (syntax/loc stx
+            (begin be ...)))]
+       [(begin0 be ...)
+        (with-syntax ([(be ...) (map mark-lambda (syntax->list #'(be ...)))])
+          (syntax/loc stx
+            (begin0 be ...)))]
+       [(define-values (v ...) ve)
+        (with-syntax ([ve (mark-lambda #'ve)])
+          (syntax/loc stx
+            (define-values (v ...) ve)))]
+       [(define-syntaxes (v ...) ve)
+        (with-syntax ([ve (mark-lambda #'ve)])
+          (syntax/loc stx
+            (define-values (v ...) ve)))]
+       [(define-values-for-syntax (v ...) ve)
+        (with-syntax ([ve (mark-lambda #'ve)])
+          (syntax/loc stx 
+            (define-values-for-syntax (v ...) ve)))]
+       [(set! v ve)
+        (with-syntax ([ve (mark-lambda #'ve)])
+          (syntax/loc stx
+            (set! v ve)))]
+       [(let-values ([(v ...) ve] ...) be ...)
+        (with-syntax ([(ve ...) (map mark-lambda (syntax->list #'(ve ...)))]
+                      [(be ...) (map mark-lambda (syntax->list #'(be ...)))])
+          (syntax/loc stx
+            (let-values ([(v ...) ve] ...) be ...)))]
+       [(letrec-values ([(v ...) ve] ...) be ...)
+        (with-syntax ([(ve ...) (map mark-lambda (syntax->list #'(ve ...)))]
+                      [(be ...) (map mark-lambda (syntax->list #'(be ...)))])
+          (syntax/loc stx
+            (letrec-values ([(v ...) ve] ...) be ...)))]
+       [(lambda formals be ...)
+        (syntax-property 
+         (with-syntax ([(be ...) (map mark-lambda (syntax->list #'(be ...)))])
+           (syntax/loc stx
+             (lambda formals be ...)))
+         lambda-key #t)]
+       [(case-lambda [formals be ...] ...)
+        (syntax-property
+         (with-syntax ([((be ...) ...) (map mark-lambda (syntax->list #'((be ...) ...)))])
+           (syntax/loc stx
+             (case-lambda [formals be ...] ...)))
+         lambda-key #t)]
+       [(if te ce ae)
+        (with-syntax ([te (mark-lambda #'te)]
+                      [ce (mark-lambda #'ce)]
+                      [ae (mark-lambda #'ae)])
+          (syntax/loc stx
+            (if te ce ae)))]
+       [(if te ce)
+        (mark-lambda (syntax/loc stx (if te ce (#%app void))))]
+       [(quote datum)
+        stx]
+       [(quote-syntax datum)
+        stx]
+       [(letrec-syntaxes+values ([(sv ...) se] ...)
+          ([(vv ...) ve] ...)
+          be ...)
+        (with-syntax ([(se ...) (map mark-lambda (syntax->list #'(se ...)))]
+                      [(ve ...) (map mark-lambda (syntax->list #'(ve ...)))]
+                      [(be ...) (map mark-lambda (syntax->list #'(be ...)))])
+          (syntax/loc stx
+            (letrec-syntaxes+values ([(sv ...) se] ...)
+              ([(vv ...) ve] ...)
+              be ...)))]
+       [(with-continuation-mark ke me be)
+        (with-syntax ([ke (mark-lambda #'ke)]
+                      [me (mark-lambda #'me)]
+                      [be (mark-lambda #'be)])
+          (syntax/loc stx
+            (with-continuation-mark ke me be)))]
+       [(#%expression . d)
+        stx]
+       [(#%app e ...)
+        (with-syntax ([(e ...) (map mark-lambda (syntax->list #'(e ...)))])
+          (syntax/loc stx
+            (#%app e ...)))]
+       [(#%top . v)
+        stx]
+       [(#%datum . d)
+        stx]
+       [(#%variable-reference . v)
+        stx]       
+       [id (identifier? #'id)
+           stx]     
+       [_
+        (raise-syntax-error 'kerncase "Dropped through:" stx)]))))
\ No newline at end of file
diff --git a/collects/web-server/prototype-web-server/lang/util.ss b/collects/web-server/prototype-web-server/lang/util.ss
index 61255c8455..4c5b183c4a 100644
--- a/collects/web-server/prototype-web-server/lang/util.ss
+++ b/collects/web-server/prototype-web-server/lang/util.ss
@@ -2,7 +2,7 @@
   (require-for-template mzscheme)
   (require (lib "kerncase.ss" "syntax")
            (lib "list.ss"))
-  (provide (all-defined))
+  (provide (all-defined-except template))
   
   (define (recertify old-expr expr)
     (syntax-recertify expr old-expr (current-code-inspector) #f))
diff --git a/collects/web-server/prototype-web-server/private/abort-resume.ss b/collects/web-server/prototype-web-server/private/abort-resume.ss
index a2821c1289..f433175ccb 100644
--- a/collects/web-server/prototype-web-server/private/abort-resume.ss
+++ b/collects/web-server/prototype-web-server/private/abort-resume.ss
@@ -17,11 +17,9 @@
    current-saved-continuation-marks-and
    
    ;; "SERVLET" INTERFACE
-   start-interaction
    send/suspend
    
    ;; "CLIENT" INTERFACE
-   run-start
    dispatch-start
    dispatch)
   
@@ -74,7 +72,7 @@
       [(list-rest f fs)
        (match f
          [(vector #f #f)
-          (error 'resume "Empty frame!")]
+          (error 'resume "Empty frame")]
          [(vector f #f)
           (call-with-values (lambda () (with-continuation-mark the-cont-key f (resume fs val)))
                             f)]
@@ -121,23 +119,6 @@
   ;; **********************************************************************
   ;; **********************************************************************
   ;; "SERVLET" INTERFACE  
-  (define decode-continuation
-    (lambda (k-val)
-      (error "interactive module not initialized: decode")))
-  
-  (define (start-continuation val)
-    (error "interactive module not initialized: start"))
-  
-  ;; start-interaction: (request -> continuation) -> request
-  ;; register the decode proc and start the interaction with the current-continuation
-  (define (start-interaction decode)
-    (set! decode-continuation decode)
-    ((lambda (k0) 
-       (abort (lambda () (set! start-continuation k0))))
-     (let ([current-marks
-            (reverse
-             (continuation-mark-set->list* (current-continuation-marks) (list the-cont-key the-save-cm-key)))])
-       (lambda x (abort (lambda () (resume current-marks x)))))))
   
   (define-closure kont x (wcs current-marks)
     (abort (lambda ()
@@ -161,24 +142,19 @@
   ;; **********************************************************************
   ;; "CLIENT" INTERFACE
   
-  (define (run-start harness start)
+  ;; dispatch-start: (request -> response) request -> reponse
+  ;; pass the initial request to the starting interaction point
+  (define (dispatch-start start req0)
     (abort/cc 
      (lambda ()
        (with-continuation-mark safe-call? '(#t start)
          (start
           (with-continuation-mark the-cont-key start
-            (harness)))))))
+            req0))))))
   
-  ;; dispatch-start: request -> reponse
-  ;; pass the initial request to the starting interaction point
-  (define (dispatch-start req0)
-    (abort/cc 
-     (lambda ()
-       (start-continuation req0))))
-  
-  ;; dispatch: request -> response
+  ;; dispatch: (request -> (request -> response)) request -> response
   ;; lookup the continuation for this request and invoke it
-  (define (dispatch req)   
+  (define (dispatch decode-continuation req)   
     (abort/cc
      (lambda ()
        (cond
diff --git a/collects/web-server/prototype-web-server/private/session.ss b/collects/web-server/prototype-web-server/private/session.ss
index 9bb2c378df..73b8c219dd 100644
--- a/collects/web-server/prototype-web-server/private/session.ss
+++ b/collects/web-server/prototype-web-server/private/session.ss
@@ -5,18 +5,17 @@
            (lib "response.ss" "web-server"))
   (provide current-session)
   
-  (define-struct session (id cust namespace handler url mod-path))
+  (define-struct session (id cust namespace servlet url mod-path))
   
   (provide/contract
    [struct session ([id number?]
                     [cust custodian?]
                     [namespace namespace?]
-                    [handler (request? . -> . response?)]
+                    [servlet (request? . -> . response?)]
                     [url url?]
                     [mod-path path?])]
    [lookup-session (number? . -> . (union session? boolean?))]
-   [new-session (custodian? namespace? url? path? . -> . session?)]
-   [start-session ((request? . -> . response?) . -> . any)])
+   [new-session (custodian? namespace? url? path? . -> . session?)])
   
   (define current-session (make-parameter #f))
   
@@ -31,25 +30,16 @@
   
   ;; new-session: namespace path -> session
   (define (new-session cust ns uri mod-path)
-    (let ([new-id (new-session-id)])
-      (make-session
-       new-id
-       cust
-       ns
-       (lambda (req) (error "session not initialized"))
-       (encode-session uri new-id)
-       mod-path)))
-  
-  ;; start-session: (request -> response) -> void
-  ;; register the session handler.
-  (define (start-session handler)
-    (let ([ses (current-session)])
-      (let ([params (current-parameterization)])
-        (set-session-handler!
-         ses
-         (lambda (req)
-           (call-with-parameterization params (lambda () (handler req))))))
-      (hash-table-put! the-session-table (session-id ses) ses)))
+    (let* ([new-id (new-session-id)]
+           [ses (make-session
+                 new-id
+                 cust
+                 ns
+                 (lambda (req) (error "session not initialized"))
+                 (encode-session uri new-id)
+                 mod-path)])
+      (hash-table-put! the-session-table new-id ses)
+      ses))
   
   ;; lookup-session: number -> (union session #f)
   (define (lookup-session ses-id)
diff --git a/collects/web-server/prototype-web-server/private/web.ss b/collects/web-server/prototype-web-server/private/web.ss
index 87a0db9d97..b5e55b4a14 100644
--- a/collects/web-server/prototype-web-server/private/web.ss
+++ b/collects/web-server/prototype-web-server/private/web.ss
@@ -8,21 +8,30 @@
            "session.ss"
            "stuff-url.ss")
   
-  (provide send/suspend/hidden
-           send/suspend/url
-           extract-proc/url embed-proc/url
-           start-servlet)
+  (provide 
+   ;; Server Interface
+   initialize-servlet
+   
+   ;; Servlet Interface
+   send/suspend/hidden
+   send/suspend/url
+   extract-proc/url
+   embed-proc/url)
   
-  ;; start-servlet: -> request
-  ;; set the initial interaction point for the servlet
-  (define (start-servlet)
-    #;(printf "start-session~n")
-    (start-session dispatch)
-    #;(printf "start-interaction~n")
-    (start-interaction
-     (lambda (req)
-       (or (request->continuation req)
-           (lambda (req) (dispatch-start req))))))
+  ;; initial-servlet : (request -> response) -> (request -> response?)
+  (define (initialize-servlet start)
+    (let ([params (current-parameterization)])
+      (lambda (req0)
+        (call-with-parameterization 
+         params
+         (lambda ()
+           (dispatch
+            (lambda (req1)
+              (or (request->continuation req1)
+                  ; Try to decode a continuation from the request,
+                  ; or, use the start procedure to initialize a session
+                  (lambda (req2) (dispatch-start start req2))))
+            req0))))))
   
   ;; send/suspend/hidden: (url input-field -> response) -> request
   ;; like send/suspend except the continuation is encoded in a hidden field
diff --git a/collects/web-server/prototype-web-server/tests/anormal-test.ss b/collects/web-server/prototype-web-server/tests/anormal-test.ss
index c104edaa94..13c912829c 100644
--- a/collects/web-server/prototype-web-server/tests/anormal-test.ss
+++ b/collects/web-server/prototype-web-server/tests/anormal-test.ss
@@ -1,6 +1,7 @@
 (module anormal-test mzscheme
   (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
-           "../lang/anormal.ss")
+           "../lang/anormal.ss"
+           "../lang/util.ss")
   (provide anormal-tests)
   
   (define (empty-env var)
@@ -68,14 +69,14 @@
                 [dat2 (syntax-object->datum #'datum2)])
             (equal? dat1 dat2))]
          [_else #f])]
-      [(lambda (formals1 ...) body1)
+      [(lambda formals1 body1)
        (syntax-case expr2 (lambda)
-         [(lambda (formals2 ...) body2)
-          (let ([syms (map gensym (syntax->symbols #'(formals1 ...)))])
-            (and (= (length syms) (length (syntax->list #'(formals2 ...))))
+         [(lambda formals2 body2)
+          (let ([syms (map gensym (syntax->symbols (formals-list #'formals1)))])
+            (and (= (length syms) (length (formals-list #'formals2)))
                  (alpha=/env
-                  (extend env1 (syntax->symbols #'(formals1 ...)) syms)
-                  (extend env2 (syntax->symbols #'(formals2 ...)) syms)
+                  (extend env1 (syntax->symbols (formals-list #'formals1)) syms)
+                  (extend env2 (syntax->symbols (formals-list #'formals2)) syms)
                   #'body1 #'body2)))]
          [_else #f])]
       [x1 (symbol? (syntax-object->datum #'x1))
@@ -197,7 +198,7 @@
                (expand (syntax ()))))
       
       (test-case
-       "qoted list of constants"
+       "quoted list of constants"
        (check alpha= (normalize-term (expand (syntax '(1 2 3))))
                (expand (syntax '(1 2 3))))))
      
@@ -329,9 +330,13 @@
       (test-case
        "begin with multiple expressions"
        (check alpha= (normalize-term (expand (syntax (begin 1 2 3))))
-               (normalize-term (expand (syntax (let ([throw-away 1])
-                                                 (let ([throw-away 2])
-                                                   3)))))))
+               (normalize-term (expand (syntax (call-with-values
+                                                (lambda () 1)
+                                                (lambda throw-away
+                                                  (call-with-values
+                                                   (lambda () 2)
+                                                   (lambda throw-away
+                                                     3)))))))))
       
       (test-case
        "cond expression"
diff --git a/collects/web-server/prototype-web-server/tests/certify-tests.ss b/collects/web-server/prototype-web-server/tests/certify-tests.ss
index ebf340e93a..8d9573bdb0 100644
--- a/collects/web-server/prototype-web-server/tests/certify-tests.ss
+++ b/collects/web-server/prototype-web-server/tests/certify-tests.ss
@@ -3,11 +3,6 @@
            "util.ss")
   (provide certify-suite)
     
-  (define the-dispatch
-    `(lambda (k*v)
-       (lambda (k*v)
-         ((car k*v) k*v))))
-
   (define certify-suite
     (test-suite
      "Test the certification process"
@@ -17,41 +12,38 @@
             
       (test-case
        "quasi-quote with splicing: need to recertify context for qq-append"
-       (let-values ([(go test-m01.1)
+       (let-values ([(test-m01.1)
                      (make-module-eval
                       (module m01.1 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start initial)
                           `(,@(list 1 2 initial)))))])         
-         (go the-dispatch)
-         (check equal? (list 1 2 3) (test-m01.1 '(dispatch-start 3)))
-         (check equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start 'foo)))))
+         (check equal? (list 1 2 3) (test-m01.1 '(dispatch-start start 3)))
+         (check equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start start 'foo)))))
       
       (test-case
        "recertify context test (1)"
-       (let-values ([(go test-m01.2)
+       (let-values ([(test-m01.2)
                      (make-module-eval
                       (module m01.1 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start initial)
                           `(foo ,@(list 1 2 3)))))])
-         (go the-dispatch)
          (check-true #t)))
       
       (test-case
        "recertify context test (2)"
-       (let-values ([(go test-m01.3)
+       (let-values ([(test-m01.3)
                      (make-module-eval  
                       (module m01.3 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start n)
                           `(n ,@(list 1 2 3)))))])
-         (go the-dispatch)
          (check-true #t)))
       
       (test-case
        "recertify context test (3)"
-       (let-values ([(go test-m01.4)
+       (let-values ([(test-m01.4)
                      (make-module-eval
                       (module m1 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -59,5 +51,4 @@
                           (define (bar n)
                             `(n ,@(list 1 2 3)))
                           (bar 7))))])
-         (go the-dispatch)
          (check-true #t)))))))
\ No newline at end of file
diff --git a/collects/web-server/prototype-web-server/tests/lang-tests.ss b/collects/web-server/prototype-web-server/tests/lang-tests.ss
index 922183cb79..bfd70f7fa6 100644
--- a/collects/web-server/prototype-web-server/tests/lang-tests.ss
+++ b/collects/web-server/prototype-web-server/tests/lang-tests.ss
@@ -31,120 +31,134 @@
       
       (test-case
        "Function application with single argument in tail position"
-       (let-values ([(go test-m00.4)
+       (let-values ([(test-m00.4)
                      (make-module-eval
                       (module m00.4 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start initial)
                           (let ([f (let ([m 7]) m)])
                             (+ f initial)))))])
-         (go the-dispatch)
-         (check = 8 (test-m00.4 '(dispatch-start 1)))))
+         (check = 8 (test-m00.4 '(dispatch-start start 1)))))
       
       (test-case
        "start-interaction in argument position of a function call"
-       (let-values ([(go test-m00.3)
+       (let-values ([(test-m00.3)
                      (make-module-eval
                       (module m00.3 (lib "lang.ss" "web-server" "prototype-web-server")
                         (define (foo x) 'foo)
                         (provide start)
                         (define (start initial)
                           (foo initial))))])
-         (go the-dispatch)
-         (check eqv? 'foo (test-m00.3 '(dispatch-start 7)))))
+         (check eqv? 'foo (test-m00.3 '(dispatch-start start 7)))))
       
       (test-case
        "identity interaction, dispatch-start called multiple times"
-       (let-values ([(go test-m00)
+       (let-values ([(test-m00)
                      (make-module-eval
                       (module m00 (lib "lang.ss" "web-server" "prototype-web-server")
                         (define (id x) x)
                         (provide start)
                         (define (start initial)
                           (id initial))))])
-         (go the-dispatch)
-         (check = 7 (test-m00 '(dispatch-start 7)))
-         (check eqv? 'foo (test-m00 '(dispatch-start 'foo)))))
+         (check = 7 (test-m00 '(dispatch-start start 7)))
+         (check eqv? 'foo (test-m00 '(dispatch-start start 'foo)))))
       
       (test-case
        "start-interaction in argument position of a primitive"
-       (let-values ([(go test-m00.1)
+       (let-values ([(test-m00.1)
                      (make-module-eval
                       (module m00.1 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start initial)
                           (+ 1 initial))))])         
-         (go the-dispatch)
-         (check = 2 (test-m00.1 '(dispatch-start 1)))))
+         (check = 2 (test-m00.1 '(dispatch-start start 1)))))
       
       (test-case
        "dispatch-start called multiple times for s-i in non-trivial context"
-       (let-values ([(go test-m00.2)
+       (let-values ([(test-m00.2)
                      (make-module-eval
                       (module m00.2 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start initial)
                           (+ (+ 1 1) initial))))])         
-         (go the-dispatch)
-         (check = 14 (test-m00.2 '(dispatch-start 12)))
-         (check = 20 (test-m00.2 '(dispatch-start 18)))))
+         (check = 14 (test-m00.2 '(dispatch-start start 12)))
+         (check = 20 (test-m00.2 '(dispatch-start start 18)))))
       
       (test-case
        "start-interaction in third position"
-       (let-values ([(go test-m01)
+       (let-values ([(test-m01)
                      (make-module-eval
                       (module m01 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start initial)
                           (+ (* 1 2) (* 3 4) initial))))])         
-         (go the-dispatch)
-         (check = 14 (test-m01 '(dispatch-start 0)))
-         (check = 20 (test-m01 '(dispatch-start 6)))))     
+         (check = 14 (test-m01 '(dispatch-start start 0)))
+         (check = 20 (test-m01 '(dispatch-start start 6))))))          
+     
+     (test-suite
+      "Tests involving multiple values"
+      (test-case
+       "begin with intermediate multiple values"
+       (let-values ([(test)
+                     (make-module-eval
+                      (module m03 (lib "lang.ss" "web-server" "prototype-web-server")
+                        (provide start)
+                        (define (start x)
+                          (begin (printf "Before~n")
+                                 (values 1 x)
+                                 (printf "After~n")
+                                 x))))])
+         (check = 3 (test `(dispatch-start start 3)))))
       
-      ;; start-interaction may be called mutitple times
-      ;; each call overwrites the previous interaction
-      ;; continuation with the latest one.
-      ; XXX We have taken this power away.
-      #;(test-case
-         "start-interaction called twice, dispatch-start will invoke different continuations"
-         (let ([test-m02
-                (make-module-eval
-                 (module m02 (lib "lang.ss" "web-server" "prototype-web-server")
-                   (define (id x) x)
-                   (+ (start-interaction id)
-                      (start-interaction id))))])
-           
-           (check-true (void? (test-m02 '(dispatch-start 1))))
-           (check = 3 (test-m02 '(dispatch-start 2)))
-           (check = 0 (test-m02 '(dispatch-start -1))))))
+      (test-case
+       "begin0 with intermediate multiple values"
+       (let-values ([(test)
+                     (make-module-eval
+                      (module m03 (lib "lang.ss" "web-server" "prototype-web-server")
+                        (provide start)
+                        (define (start x)
+                          (begin0 x
+                                  (printf "Before~n")
+                                  (values 1 x)
+                                  (printf "After~n")))))])
+         (check = 3 (test `(dispatch-start start 3)))))
+      
+      (test-case
+       "begin0 with multiple values"
+       (let-values ([(test)
+                     (make-module-eval
+                      (module m03 (lib "lang.ss" "web-server" "prototype-web-server")
+                        (provide start)
+                        (define (start x)
+                          (let-values ([(_ ans)
+                                        (begin0 (values 1 x) 
+                                                (printf "Before~n")
+                                                x
+                                                (printf "After~n"))])
+                            ans))))])
+         (check = 3 (test `(dispatch-start start 3))))))
      
-     
-     
-     ;; ****************************************
-     ;; ****************************************
-     ;; TESTS INVOLVING CALL/CC
      (test-suite
       "Tests Involving call/cc"
       
       (test-case
        "continuation invoked in non-trivial context from within proc"
-       (let-values ([(go test-m03)
+       (let-values ([(test-m03)
                      (make-module-eval
                       (module m03 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
                         (define (start x)
                           (let/cc k
                             (+ 2 4 (k 3) 6 8)))))])         
-         (go the-dispatch)
-         (check = 3 (test-m03 '(dispatch-start 'foo)))
-         (check = 3 (test-m03 '(dispatch-start 7)))))
+         (check = 3 (test-m03 '(dispatch-start start 'foo)))
+         (check = 3 (test-m03 '(dispatch-start start 7)))))
       
       ;; in the following test, if you modify
       ;; resume to print the "stack" you will
       ;; see that this is not tail recursive
       (test-case
        "non-tail-recursive 'escaping' continuation"
-       (let-values ([(go test-m04)
+       (let-values ([(test-m04)
                      (make-module-eval
                       (module m04 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -156,9 +170,8 @@
                               [else
                                (* (car ln)
                                   (start (cdr ln)))])))))])
-         (go the-dispatch)
-         (check = 0 (test-m04 '(dispatch-start (list 1 2 3 4 5 6 7 0 8 9))))
-         (check = 120 (test-m04 '(dispatch-start (list 1 2 3 4 5))))))
+         (check = 0 (test-m04 '(dispatch-start start (list 1 2 3 4 5 6 7 0 8 9))))
+         (check = 120 (test-m04 '(dispatch-start start (list 1 2 3 4 5))))))
       
       ;; this version captures the continuation
       ;; outside the recursion and should be tail
@@ -166,7 +179,7 @@
       ;; as expected.
       (test-case
        "tail-recursive escaping continuation"
-       (let-values ([(go test-m05)
+       (let-values ([(test-m05)
                      (make-module-eval
                       (module m05 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)                 
@@ -182,9 +195,8 @@
                             [else
                              (* (car ln)
                                 (mult/escape escape (cdr ln)))]))))])     
-         (go the-dispatch)
-         (check = 0 (test-m05 '(dispatch-start (list 1 2 3 0 4 5 6))))
-         (check = 120 (test-m05 '(dispatch-start (list 1 2 3 4 5)))))))
+         (check = 0 (test-m05 '(dispatch-start start (list 1 2 3 0 4 5 6))))
+         (check = 120 (test-m05 '(dispatch-start start (list 1 2 3 4 5)))))))
      
      ;; ****************************************
      ;; ****************************************
@@ -192,53 +204,52 @@
      (test-suite
       "Tests Involving send/suspend"
       
-      ; XXX This doesn't work, because we don't allow a different dispatcher
-      #;(test-case
-         "curried add with send/suspend"
-         (let ([table-01-eval
-                (make-module-eval
-                 (module table01 mzscheme
-                   (provide store-k
-                            lookup-k)
-                   
-                   (define the-table (make-hash-table))
-                   
-                   (define (store-k k)
-                     (let ([key (string->symbol (symbol->string (gensym 'key)))])
-                       (hash-table-put! the-table key k)
-                       key))
-                   (define (lookup-k key-pair)
-                     (hash-table-get the-table (car key-pair) (lambda () #f)))))])         
-           (table-01-eval
-            '(module m06 (lib "lang.ss" "web-server" "prototype-web-server")
-               (require table01)
-               (provide start)
-               
-               (define (gn which)
-                 (cadr
-                  (send/suspend
-                   (lambda (k)
-                     (let ([ignore (printf "Please send the ~a number.~n" which)])
-                       (store-k k))))))
-               
-               (define (start ignore)
-                 (let ([result (+ (gn "first") (gn "second"))])
-                   (let ([ignore (printf "The answer is: ~s~n" result)])
-                     result)))))         
-           (table-01-eval '(require m06))         
-           (let* ([first-key (table-01-eval '(dispatch-start 'foo))]
-                  [second-key (table-01-eval `(dispatch '(,first-key 1)))]
-                  [third-key (table-01-eval `(dispatch '(,first-key -7)))])                    
-             (check = 3 (table-01-eval `(dispatch '(,second-key 2))))
-             (check = 4 (table-01-eval `(dispatch '(,second-key 3))))
-             (check-true (zero? (table-01-eval `(dispatch '(,second-key -1)))))
-             (check = -7 (table-01-eval `(dispatch '(,third-key 0))))
-             (check-true (zero? (table-01-eval `(dispatch '(,third-key 7))))))))
+      (test-case
+       "curried add with send/suspend"
+       (let ([table-01-eval
+              (make-module-eval
+               (module table01 mzscheme
+                 (provide store-k
+                          lookup-k)
+                 
+                 (define the-table (make-hash-table))
+                 
+                 (define (store-k k)
+                   (let ([key (string->symbol (symbol->string (gensym 'key)))])
+                     (hash-table-put! the-table key k)
+                     key))
+                 (define (lookup-k key-pair)
+                   (hash-table-get the-table (car key-pair) (lambda () #f)))))])         
+         (table-01-eval
+          '(module m06 (lib "lang.ss" "web-server" "prototype-web-server")
+             (require table01)
+             (provide start)
+             
+             (define (gn which)
+               (cadr
+                (send/suspend
+                 (lambda (k)
+                   (let ([ignore (printf "Please send the ~a number.~n" which)])
+                     (store-k k))))))
+             
+             (define (start ignore)
+               (let ([result (+ (gn "first") (gn "second"))])
+                 (let ([ignore (printf "The answer is: ~s~n" result)])
+                   result)))))         
+         (table-01-eval '(require m06))         
+         (let* ([first-key (table-01-eval '(dispatch-start start 'foo))]
+                [second-key (table-01-eval `(dispatch lookup-k '(,first-key 1)))]
+                [third-key (table-01-eval `(dispatch lookup-k '(,first-key -7)))])                    
+           (check = 3 (table-01-eval `(dispatch lookup-k '(,second-key 2))))
+           (check = 4 (table-01-eval `(dispatch lookup-k '(,second-key 3))))
+           (check-true (zero? (table-01-eval `(dispatch lookup-k '(,second-key -1)))))
+           (check = -7 (table-01-eval `(dispatch lookup-k '(,third-key 0))))
+           (check-true (zero? (table-01-eval `(dispatch lookup-k '(,third-key 7))))))))
       
       (test-case
        "curried with send/suspend and serializaztion"
        
-       (let-values ([(go test-m06.1)
+       (let-values ([(test-m06.1)
                      (make-module-eval
                       (module m06.1 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -253,25 +264,21 @@
                           (let ([result (+ (gn "first") (gn "second"))])
                             (let ([ignore (printf "The answer is: ~s~n" result)])
                               result)))))])
-         (go the-dispatch)
-         (let* ([first-key (test-m06.1 '(dispatch-start 'foo))]
-                [second-key (test-m06.1 `(dispatch (list (deserialize (serialize ,first-key)) 1)))]
-                [third-key (test-m06.1 `(dispatch (list (deserialize (serialize ,first-key)) -7)))])
-           (check = 3 (test-m06.1 `(dispatch (list ,second-key 2))))
-           (check = 4 (test-m06.1 `(dispatch (list ,second-key 3))))
-           (check-true (zero? (test-m06.1 `(dispatch (list ,second-key -1)))))
-           (check = -7 (test-m06.1 `(dispatch (list ,third-key 0))))
-           (check-true (zero? (test-m06.1 `(dispatch (list ,third-key 7)))))))))
+         (let* ([first-key (test-m06.1 '(dispatch-start start 'foo))]
+                [second-key (test-m06.1 `(dispatch ,the-dispatch (list (deserialize (serialize ,first-key)) 1)))]
+                [third-key (test-m06.1 `(dispatch ,the-dispatch (list (deserialize (serialize ,first-key)) -7)))])
+           (check = 3 (test-m06.1 `(dispatch ,the-dispatch (list ,second-key 2))))
+           (check = 4 (test-m06.1 `(dispatch ,the-dispatch (list ,second-key 3))))
+           (check-true (zero? (test-m06.1 `(dispatch ,the-dispatch (list ,second-key -1)))))
+           (check = -7 (test-m06.1 `(dispatch ,the-dispatch (list ,third-key 0))))
+           (check-true (zero? (test-m06.1 `(dispatch ,the-dispatch (list ,third-key 7)))))))))
      
-     ;; ****************************************
-     ;; ****************************************
-     ;; TESTS INVOLVING LETREC
      (test-suite
       "Tests Involving letrec"
       
       (test-case
        "mutually recursive even? and odd?"
-       (let-values ([(go test-m07)
+       (let-values ([(test-m07)
                      (make-module-eval
                       (module m07 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -283,15 +290,14 @@
                                            (and (not (zero? n))
                                                 (even? (sub1 n))))])
                             (even? initial)))))])         
-         (go the-dispatch)
-         (check-true (test-m07 '(dispatch-start 0)))
-         (check-true (test-m07 '(dispatch-start 16)))
-         (check-false (test-m07 '(dispatch-start 1)))
-         (check-false (test-m07 '(dispatch-start 7)))))
+         (check-true (test-m07 '(dispatch-start start 0)))
+         (check-true (test-m07 '(dispatch-start start 16)))
+         (check-false (test-m07 '(dispatch-start start 1)))
+         (check-false (test-m07 '(dispatch-start start 7)))))
       
       (test-case
        "send/suspend on rhs of letrec binding forms"
-       (let-values ([(go test-m08)
+       (let-values ([(test-m08)
                      (make-module-eval
                       (module m08 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -310,51 +316,46 @@
                             (let ([result (g (gn "third"))])
                               (let ([ignore (printf "The answer is: ~s~n" result)])
                                 result))))))])
-         (go the-dispatch)
-         (let* ([k0 (test-m08 '(serialize (dispatch-start 'foo)))]
-                [k1 (test-m08 `(serialize (dispatch (list (deserialize ',k0) 1))))]
-                [k2 (test-m08 `(serialize (dispatch (list (deserialize ',k1) 2))))])
-           (check = 6 (test-m08 `(dispatch (list (deserialize ',k2) 3))))
-           (check = 9 (test-m08 `(dispatch (list (deserialize ',k2) 6))))
-           (let* ([k1.1 (test-m08 `(serialize (dispatch (list (deserialize ',k0) -1))))]
-                  [k2.1 (test-m08 `(serialize (dispatch (list (deserialize ',k1.1) -2))))])
-             (check-true (zero? (test-m08 `(dispatch (list (deserialize ',k2.1) 3)))))
-             (check = 6 (test-m08 `(dispatch (list (deserialize ',k2) 3)))))))))
+         (let* ([k0 (test-m08 '(serialize (dispatch-start start 'foo)))]
+                [k1 (test-m08 `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) 1))))]
+                [k2 (test-m08 `(serialize (dispatch ,the-dispatch (list (deserialize ',k1) 2))))])
+           (check = 6 (test-m08 `(dispatch ,the-dispatch (list (deserialize ',k2) 3))))
+           (check = 9 (test-m08 `(dispatch ,the-dispatch (list (deserialize ',k2) 6))))
+           (let* ([k1.1 (test-m08 `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) -1))))]
+                  [k2.1 (test-m08 `(serialize (dispatch ,the-dispatch (list (deserialize ',k1.1) -2))))])
+             (check-true (zero? (test-m08 `(dispatch ,the-dispatch (list (deserialize ',k2.1) 3)))))
+             (check = 6 (test-m08 `(dispatch ,the-dispatch (list (deserialize ',k2) 3)))))))))
      
-     ;; ****************************************
-     ;; ****************************************
-     ;; TEST UNSAFE CONTEXT CONDITION
      (test-suite
       "Unsafe Context Condition Tests"
       
-      ; XXX Bizarre
-      #;(test-case
-         "simple attempt to capture a continuation from an unsafe context"
+      (test-case
+       "simple attempt to capture a continuation from an unsafe context"
+       
+       (let-values ([(nta-eval)
+                     (make-module-eval
+                      (module nta mzscheme
+                        (provide non-tail-apply)
+                        
+                        (define (non-tail-apply f . args)
+                          (let ([result (apply f args)])
+                            (printf "result = ~s~n" result)
+                            result))))])
+         (nta-eval '(module m09 (lib "lang.ss" "web-server" "prototype-web-server")
+                      (require nta)
+                      (provide start)
+                      (define (start ignore)
+                        (non-tail-apply (lambda (x) (let/cc k (k x))) 7))))
          
-         (let-values ([(go nta-eval)
-                       (make-module-eval
-                        (module nta mzscheme
-                          (provide non-tail-apply)
-                          
-                          (define (non-tail-apply f . args)
-                            (let ([result (apply f args)])
-                              (printf "result = ~s~n" result)
-                              result))))])
-           (nta-eval '(module m09 (lib "lang.ss" "web-server" "prototype-web-server")
-                        (require nta)
-                        (provide start)
-                        (define (start ignore)
-                          (non-tail-apply (lambda (x) (let/cc k (k x))) 7))))
-           
-           (nta-eval '(require m09))
-           
-           (check-true (catch-unsafe-context-exn
-                        (lambda () (nta-eval '(dispatch-start 'foo)))))))
+         (nta-eval '(require m09))
+         
+         (check-true (catch-unsafe-context-exn
+                      (lambda () (nta-eval '(dispatch-start start 'foo)))))))
       
       (test-case
        "sanity-check: capture continuation from safe version of context"
        
-       (let-values ([(go m10-eval)
+       (let-values ([(m10-eval)
                      (make-module-eval
                       (module m10 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -364,13 +365,12 @@
                             result))
                         (define (start ignore)
                           (nta (lambda (x) (let/cc k (k x))) 7))))])         
-         (go the-dispatch)
-         (check = 7 (m10-eval '(dispatch-start 'foo)))))
+         (check = 7 (m10-eval '(dispatch-start start 'foo)))))
       
       (test-case
        "attempt continuation capture from standard call to map"
        
-       (let-values ([(go m11-eval)
+       (let-values ([(m11-eval)
                      (make-module-eval
                       (module m11 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -378,39 +378,37 @@
                           (map
                            (lambda (x) (let/cc k k))
                            (list 1 2 3)))))])         
-         (go the-dispatch)
          (check-true (catch-unsafe-context-exn
-                      (lambda () (m11-eval '(dispatch-start 'foo)))))))
+                      (lambda () (m11-eval '(dispatch-start start 'foo)))))))
       
       ;; if the continuation-capture is attempted in tail position then we
       ;; should be just fine.
-      ; XXX Weird
-      #;(test-case
-         "continuation capture from tail position of untranslated procedure"
+      (test-case
+       "continuation capture from tail position of untranslated procedure"
+       
+       (let ([ta-eval
+              (make-module-eval
+               (module ta mzscheme
+                 (provide tail-apply)
+                 
+                 (define (tail-apply f . args)
+                   (apply f args))))])
          
-         (let ([ta-eval
-                (make-module-eval
-                 (module ta mzscheme
-                   (provide tail-apply)
-                   
-                   (define (tail-apply f . args)
-                     (apply f args))))])
-           
-           (ta-eval '(module m12 (lib "lang.ss" "web-server" "prototype-web-server")
-                       (require ta)
-                       (provide start)
-                       (define (start initial)
-                         (+ initial 
-                            (tail-apply (lambda (x) (let/cc k (k x))) 1)))))
-           
-           (ta-eval '(require m12))
-           
-           (check = 2 (ta-eval '(dispatch-start 1)))))
+         (ta-eval '(module m12 (lib "lang.ss" "web-server" "prototype-web-server")
+                     (require ta)
+                     (provide start)
+                     (define (start initial)
+                       (+ initial 
+                          (tail-apply (lambda (x) (let/cc k (k x))) 1)))))
+         
+         (ta-eval '(require m12))
+         
+         (check = 2 (ta-eval '(dispatch-start start 1)))))
       
       (test-case
        "attempt send/suspend from standard call to map"
        
-       (let-values ([(go m13-eval)
+       (let-values ([(m13-eval)
                      (make-module-eval
                       (module m11 (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -421,35 +419,33 @@
                                           (let ([ignore (printf "n = ~s~n" n)])
                                             k))))
                            (list 1 2 3)))))])
-         (go the-dispatch)
          (check-true (catch-unsafe-context-exn
-                      (lambda () (m13-eval '(dispatch-start 'foo)))))))
+                      (lambda () (m13-eval '(dispatch-start start 'foo)))))))
       
-      ; XXX Weird
-      #;(test-case
-         "attempt send/suspend from tail position of untranslated procedure"
+      (test-case
+       "attempt send/suspend from tail position of untranslated procedure"
+       
+       (let-values ([(ta-eval)
+                     (make-module-eval
+                      (module ta mzscheme
+                        (provide tail-apply)
+                        
+                        (define (tail-apply f . args)
+                          (apply f args))))])
          
-         (let-values ([(go ta-eval)
-                       (make-module-eval
-                        (module ta mzscheme
-                          (provide tail-apply)
-                          
-                          (define (tail-apply f . args)
-                            (apply f args))))])
-           
-           (ta-eval '(module m14 (lib "lang.ss" "web-server" "prototype-web-server")
-                       (require ta)
-                       (provide start)
-                       (define (start ignore)
-                         (+ 1 (tail-apply
-                               (lambda (n)
-                                 (cadr
-                                  (send/suspend
-                                   (lambda (k)
-                                     (let ([ignore (printf "n = ~s~n" n)])
-                                       k))))) 7)))))
-           (ta-eval '(require m14))
-           
-           (let ([k0 (ta-eval '(dispatch-start 'foo))])
-             (check = 3 (ta-eval `(dispatch (list ,k0 2))))
-             (check = 0 (ta-eval `(dispatch (list ,k0 -1)))))))))))
\ No newline at end of file
+         (ta-eval '(module m14 (lib "lang.ss" "web-server" "prototype-web-server")
+                     (require ta)
+                     (provide start)
+                     (define (start ignore)
+                       (+ 1 (tail-apply
+                             (lambda (n)
+                               (cadr
+                                (send/suspend
+                                 (lambda (k)
+                                   (let ([ignore (printf "n = ~s~n" n)])
+                                     k))))) 7)))))
+         (ta-eval '(require m14))
+         
+         (let ([k0 (ta-eval '(dispatch-start start 'foo))])
+           (check = 3 (ta-eval `(dispatch ,the-dispatch (list ,k0 2))))
+           (check = 0 (ta-eval `(dispatch ,the-dispatch (list ,k0 -1)))))))))))
\ No newline at end of file
diff --git a/collects/web-server/prototype-web-server/tests/param-tests.ss b/collects/web-server/prototype-web-server/tests/param-tests.ss
index dbae320126..cb6858d72e 100644
--- a/collects/web-server/prototype-web-server/tests/param-tests.ss
+++ b/collects/web-server/prototype-web-server/tests/param-tests.ss
@@ -20,7 +20,7 @@
       
       (test-case
        "web-parameterize does not overwrite with multiple parameters"
-       (let-values ([(go meval)
+       (let-values ([(meval)
                      (make-module-eval
                       (module m (lib "lang.ss" "web-server" "prototype-web-server")
                         (define first (make-web-parameter #f))
@@ -30,13 +30,12 @@
                           (web-parameterize ([first 1]
                                              [second 2])
                                             (+ (first) (second))))))])
-         (go the-dispatch)
-         (check = 3 (meval '(dispatch-start #f)))))
+         (check = 3 (meval '(dispatch-start start #f)))))
       
       (test-case
        "web-parameterize does not overwrite with multiple parameters across send/suspend"
        
-       (let-values ([(go meval)
+       (let-values ([(meval)
                      (make-module-eval
                       (module m (lib "lang.ss" "web-server" "prototype-web-server")
                         (provide start)
@@ -47,6 +46,5 @@
                                              [second 2])
                                             (send/suspend (lambda (k) k))
                                             (+ (first) (second))))))])
-         (go the-dispatch)
-         (let ([first-key (meval '(dispatch-start #f))])
-           (check = 3 (meval `(dispatch (list ,first-key #f)))))))))))
\ No newline at end of file
+         (let ([first-key (meval '(dispatch-start start #f))])
+           (check = 3 (meval `(dispatch ,the-dispatch (list ,first-key #f)))))))))))
\ No newline at end of file
diff --git a/collects/web-server/prototype-web-server/tests/persistent-close-tests.ss b/collects/web-server/prototype-web-server/tests/persistent-close-tests.ss
index df89b1cd16..b4097a682b 100644
--- a/collects/web-server/prototype-web-server/tests/persistent-close-tests.ss
+++ b/collects/web-server/prototype-web-server/tests/persistent-close-tests.ss
@@ -8,7 +8,7 @@
   
   (define persistent-close-suite
     (test-suite
-     "tests for persistent-close.ss"
+     "Tests for persistent-close.ss"
      
      (test-case
       "file-vector references"
diff --git a/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss b/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss
index b5296e5fab..4abb13cc1f 100644
--- a/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss
+++ b/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss
@@ -57,32 +57,29 @@
      
      (test-case
       "compose url-parts and recover-serial (1)"
-      (let-values ([(go ev) (make-eval/mod-path m00)])
-        (go the-dispatch)
-        (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
+      (let-values ([(ev) (make-eval/mod-path m00)])
+        (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start start 'foo)))
                                         m00)]
-               [k1 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
+               [k1 (simplify-unsimplify (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) 1))))
                                         m00)]
-               [k2 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
+               [k2 (simplify-unsimplify (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k1) 2))))
                                         m00)])
-          (check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3))))))))
+          (check-true (= 6 (ev `(dispatch ,the-dispatch (list (deserialize ',k2) 3))))))))
      
      (test-case
       "compose url-parts and recover-serial (2)"
-      (let-values ([(go ev) (make-eval/mod-path m01)])
-        (go the-dispatch)
-        (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
+      (let-values ([(ev) (make-eval/mod-path m01)])
+        (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start start 'foo)))
                                         m01)])
-          (check-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7))))))))
+          (check-true (= 7 (ev `(dispatch ,the-dispatch (list (deserialize ',k0) 7))))))))
      
      (test-case 
       "compose stuff-url and unstuff-url and recover the serial"
-      (let-values ([(go ev) (make-eval/mod-path m00)])
-        (go the-dispatch)
-        (let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo)))
+      (let-values ([(ev) (make-eval/mod-path m00)])
+        (let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start start 'foo)))
                                   uri0 m00)]
-               [k1 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
+               [k1 (stuff-unstuff (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) 1))))
                                   uri0 m00)]
-               [k2 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
+               [k2 (stuff-unstuff (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k1) 2))))
                                   uri0 m00)])
-          (check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3)))))))))))
\ No newline at end of file
+          (check-true (= 6 (ev `(dispatch ,the-dispatch (list (deserialize ',k2) 3)))))))))))
\ No newline at end of file
diff --git a/collects/web-server/prototype-web-server/tests/util.ss b/collects/web-server/prototype-web-server/tests/util.ss
index 488b9e4ace..a661223170 100644
--- a/collects/web-server/prototype-web-server/tests/util.ss
+++ b/collects/web-server/prototype-web-server/tests/util.ss
@@ -2,15 +2,6 @@
   (provide make-module-eval
            make-eval/mod-path)
   
-  (define (go ns)
-    (lambda (dispatch-sexpr)
-      (parameterize ([current-namespace ns])
-        (eval `(run-start 
-                (lambda ()
-                  (start-interaction 
-                      ,dispatch-sexpr))
-                start)))))
-  
   (define-syntax (make-module-eval m-expr)
     (syntax-case m-expr (module)
       [(_ (module m-id . rest))
@@ -21,11 +12,9 @@
              (eval '(module m-id . rest))
              (eval '(require m-id)))
            
-           (values
-            (go ns)
-            (lambda (s-expr)
-              (parameterize ([current-namespace ns])
-                (eval s-expr)))))]
+           (lambda (s-expr)
+             (parameterize ([current-namespace ns])
+                (eval s-expr))))]
       [else
        (raise-syntax-error #f "make-module-evel: dropped through" m-expr)]))
   
@@ -35,7 +24,6 @@
         (eval `(require (lib "abort-resume.ss" "web-server" "prototype-web-server" "private")
                         (lib "serialize.ss")
                         ,pth)))
-      (values (go ns)
-              (lambda (expr)
-                (parameterize ([current-namespace ns])
-                  (eval expr)))))))
\ No newline at end of file
+      (lambda (expr)
+        (parameterize ([current-namespace ns])
+          (eval expr))))))
\ No newline at end of file