diff --git a/collects/2htdp/private/checked-cell.rkt b/collects/2htdp/private/checked-cell.rkt
index 0f69390edc..357dfed519 100644
--- a/collects/2htdp/private/checked-cell.rkt
+++ b/collects/2htdp/private/checked-cell.rkt
@@ -68,9 +68,14 @@
           (tp-error 'check-with "the test function ~a is expected to return a boolean, but it returned ~v" 
                     (object-name ok?) b))
         (unless b
+          (define check-with-name 
+            (let ([n (symbol->string (object-name ok?))])
+              (if (regexp-match "check-with" n)
+                  "handler"
+                  n)))
           (tp-error 'check-with "~a ~a ~v, which fails to pass check-with's ~a test"
                     tag (if say-evaluated-to "evaluated to" "returned") 
-                    nw (object-name ok?)))
+                    nw check-with-name))
         nw))
     
     ;; Symbol Any -> Void 
diff --git a/collects/2htdp/private/clauses-spec-and-process.rkt b/collects/2htdp/private/clauses-spec-and-process.rkt
index 6c281fa338..798b7c8d15 100644
--- a/collects/2htdp/private/clauses-spec-and-process.rkt
+++ b/collects/2htdp/private/clauses-spec-and-process.rkt
@@ -86,7 +86,10 @@
                [(null? spec) #false]
                [(or (free-identifier=? (caar spec) kw)
                     (free-identifier=? (caar spec) kw-alt))
-                (syntax->list (cdar spec))]
+                ; (syntax->list (cdar spec))
+                (for/list ([i (syntax->list (cdar spec))])
+                  (define n  (string->symbol (format "~a handler" (syntax-e (caar spec)))))
+                  (syntax-property  i 'inferred-name n))]
                [else (loop (cdr spec))])))
          (if r ((third s) r) (fourth s)))
        Spec))
diff --git a/collects/2htdp/tests-failed/key-error.rkt b/collects/2htdp/tests/key-error.rkt
similarity index 59%
rename from collects/2htdp/tests-failed/key-error.rkt
rename to collects/2htdp/tests/key-error.rkt
index 805b6dabcd..eae0051257 100644
--- a/collects/2htdp/tests-failed/key-error.rkt
+++ b/collects/2htdp/tests/key-error.rkt
@@ -18,3 +18,18 @@
                              (unless (and hdl (cons? (regexp-match "on-tick" (second hdl))))
                                (error 'test "expected: \"on-tick\", actual: ~e" (second hdl))))))
   (main))
+
+
+(define (my-fun x) "hi")
+
+(with-handlers ((exn:fail? 
+                 (lambda (x) 
+                   (define msg (exn-message x))
+                   (define hdl (regexp-match "check-with's handler test" msg))
+                   (unless hdl
+                     (error 'test "expected: \"check-with's handler test, error says: ~e" msg)))))
+  (big-bang 0 
+            [to-draw (lambda (x) (circle 1 'solid 'red))]
+            [on-tick (lambda (x) (my-fun x))]
+            [check-with (lambda (x) (number? x))])
+  (raise `(bad "must fail")))
diff --git a/collects/2htdp/xtest b/collects/2htdp/xtest
index 9ba11282ef..52553b9325 100755
--- a/collects/2htdp/xtest
+++ b/collects/2htdp/xtest
@@ -10,6 +10,7 @@ run() {
 
 cd tests 
 
+run key-error.rkt
 run bad-draw.rkt
 run error-in-tick.rkt
 run error-in-draw.rkt
@@ -34,3 +35,4 @@ run record-stop-when.rkt
 run stop-when-crash.rkt
 run on-tick-universe-with-limit.rkt
 run on-tick-with-limit.rkt
+
diff --git a/collects/compiler/cm.rkt b/collects/compiler/cm.rkt
index 1cd80e8340..36364fa35b 100644
--- a/collects/compiler/cm.rkt
+++ b/collects/compiler/cm.rkt
@@ -675,43 +675,128 @@
 
 (define (make-compile-lock)
   (define-values (manager-side-chan build-side-chan) (place-channel))
-  (struct pending (response-chan bytes))
+  (struct pending (response-chan zo-path died-chan-manager-side) #:transparent)
+  (struct running (zo-path died-chan-manager-side) #:transparent)
   
   (define currently-locked-files (make-hash))
   (define pending-requests '())
+  (define running-compiles '())
   
   (thread
    (λ ()
      (let loop ()
-       (define req (place-channel-get manager-side-chan))
-       (define command (list-ref req 0))
-       (define bytes (list-ref req 1))
-       (define response-manager-side (list-ref req 2))
-       (cond
-         [(eq? command 'lock)
-          (cond
-            [(hash-ref currently-locked-files bytes #f)
-             (set! pending-requests (cons (pending response-manager-side bytes)
-                                          pending-requests))
-             (loop)]
-            [else
-             (hash-set! currently-locked-files bytes #t)
-             (place-channel-put response-manager-side #t)
-             (loop)])]
-         [(eq? command 'unlock)
-          (define (same-bytes? pending) (equal? (pending-bytes pending) bytes))
-          (define to-unlock (filter same-bytes? pending-requests))
-          (set! pending-requests (filter (compose not same-bytes?) pending-requests))
-          (for ([pending (in-list to-unlock)])
-            (place-channel-put (pending-response-chan pending) #f))
-          (hash-remove! currently-locked-files bytes)
-          (loop)]))))
+       (apply
+        sync
+        (handle-evt
+         manager-side-chan
+         (λ (req)
+           (define command (list-ref req 0))
+           (define zo-path (list-ref req 1))
+           (define response-manager-side (list-ref req 2))
+           (define died-chan-manager-side (list-ref req 3))
+           (define compilation-thread-id (list-ref req 4))
+           (case command
+             [(lock)
+              (cond
+                [(hash-ref currently-locked-files zo-path #f)
+                 (log-info (format "compile-lock: ~s ~a already locked" zo-path compilation-thread-id))
+                 (set! pending-requests (cons (pending response-manager-side zo-path died-chan-manager-side)
+                                              pending-requests))
+                 (loop)]
+                [else
+                 (log-info (format "compile-lock: ~s ~a obtained lock" zo-path compilation-thread-id))
+                 (hash-set! currently-locked-files zo-path #t)
+                 (place-channel-put response-manager-side #t)
+                 (set! running-compiles (cons (running zo-path died-chan-manager-side) running-compiles))
+                 (loop)])]
+             [(unlock)
+              (log-info (format "compile-lock: ~s ~a unlocked" zo-path compilation-thread-id))
+              (define (same-pending-zo-path? pending) (equal? (pending-zo-path pending) zo-path))
+              (define to-unlock (filter same-pending-zo-path? pending-requests))
+              (set! pending-requests (filter (compose not same-pending-zo-path?) pending-requests))
+              (for ([pending (in-list to-unlock)])
+                (place-channel-put (pending-response-chan pending) #f))
+              (hash-remove! currently-locked-files zo-path)
+              (set! running-compiles (filter (λ (a-running) (not (equal? (running-zo-path a-running) zo-path)))
+                                             running-compiles))
+              (loop)])))
+        (for/list ([running-compile (in-list running-compiles)])
+          (handle-evt
+           (running-died-chan-manager-side running-compile)
+           (λ (compilation-thread-id)
+             (define zo-path (running-zo-path running-compile))
+             (set! running-compiles (remove running-compile running-compiles))
+             (define same-zo-pending 
+               (filter (λ (pending) (equal? zo-path (pending-zo-path pending)))
+                       pending-requests))
+             (cond
+               [(null? same-zo-pending)
+                (log-info (format "compile-lock: ~s ~a died; no else waiting" zo-path compilation-thread-id))
+                (hash-remove! currently-locked-files zo-path)
+                (loop)]
+               [else
+                (log-info (format "compile-lock: ~s ~a died; someone else waiting" zo-path compilation-thread-id))
+                (define to-be-running (car same-zo-pending))
+                (set! pending-requests (remq to-be-running pending-requests))
+                (place-channel-put (pending-response-chan to-be-running) #t)
+                (set! running-compiles 
+                      (cons (running zo-path (pending-died-chan-manager-side to-be-running))
+                            running-compiles))
+                (loop)]))))))))
   
   build-side-chan)
 
-(define (compile-lock->parallel-lock-client build-side-chan)
+(define (compile-lock->parallel-lock-client build-side-chan [custodian #f])
+  (define monitor-threads (make-hash))
+  (define add-monitor-chan (make-channel))
+  (define kill-monitor-chan (make-channel))
+  
+  (when custodian
+    (parameterize ([current-custodian custodian])
+      (thread
+       (λ () 
+         (let loop ()
+           (sync
+            (handle-evt add-monitor-chan
+                        (λ (arg)
+                          (define-values (zo-path monitor-thread) (apply values arg))
+                          (hash-set! monitor-threads zo-path monitor-thread)
+                          (loop)))
+            (handle-evt kill-monitor-chan
+                        (λ (zo-path)
+                          (define thd/f (hash-ref monitor-threads zo-path #f))
+                          (when thd/f (kill-thread thd/f))
+                          (hash-remove! monitor-threads zo-path)
+                          (loop)))))))))
+  
   (λ (command zo-path)
+    (define compiling-thread (current-thread))
     (define-values (response-builder-side response-manager-side) (place-channel))
-    (place-channel-put build-side-chan (list command zo-path response-manager-side))
-    (when (eq? command 'lock)
-      (place-channel-get response-builder-side))))
+    (define-values (died-chan-compiling-side died-chan-manager-side) (place-channel))
+    (place-channel-put build-side-chan (list command 
+                                             zo-path
+                                             response-manager-side
+                                             died-chan-manager-side 
+                                             (eq-hash-code compiling-thread)))
+    (cond
+      [(eq? command 'lock)
+       (define monitor-thread
+        (and custodian
+             (parameterize ([current-custodian custodian])
+               (thread
+                (λ ()
+                  (thread-wait compiling-thread)
+                  ;; compiling thread died; alert the server
+                  ;; & remove this thread from the table
+                  (place-channel-put died-chan-compiling-side (eq-hash-code compiling-thread))
+                  (channel-put kill-monitor-chan zo-path))))))
+       (when monitor-thread (channel-put add-monitor-chan (list zo-path monitor-thread)))
+       (define res (place-channel-get response-builder-side))
+       (when monitor-thread
+         (unless res ;; someone else finished compilation for us; kill the monitor
+           (channel-put kill-monitor-chan zo-path)))
+       res]
+      [(eq? command 'unlock)
+       (when custodian 
+         ;; we finished the compilation; kill the monitor
+         (channel-put kill-monitor-chan zo-path))])))
diff --git a/collects/compiler/commands/make.rkt b/collects/compiler/commands/make.rkt
index fc237ce2b8..127b521795 100644
--- a/collects/compiler/commands/make.rkt
+++ b/collects/compiler/commands/make.rkt
@@ -66,7 +66,7 @@
                       (lambda (p)
                         (set! did-one? #t)
                         (when (verbose)
-                          (printf "  making ~s\n" (path->string p))))])
+                          (printf "  making ~s\n" p)))])
         (for ([file source-files])
           (unless (file-exists? file)
             (error mzc-symbol "file does not exist: ~a" file))
diff --git a/collects/compiler/decompile.rkt b/collects/compiler/decompile.rkt
index 903e6843ef..053ad00fb9 100644
--- a/collects/compiler/decompile.rkt
+++ b/collects/compiler/decompile.rkt
@@ -164,16 +164,20 @@
 
 (define (decompile-module mod-form stack stx-ht)
   (match mod-form
-    [(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported 
+    [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported 
                        max-let-depth dummy lang-info internal-context))
      (let-values ([(globs defns) (decompile-prefix prefix stx-ht)]
                   [(stack) (append '(#%modvars) stack)]
                   [(closed) (make-hasheq)])
        `(module ,name ....
           ,@defns
-          ,@(map (lambda (form)
-                   (decompile-form form globs stack closed stx-ht))
-                 syntax-body)
+          ,@(for/list ([b (in-list syntax-bodies)])
+              (let loop ([n (sub1 (car b))])
+                (if (zero? n)
+                    (cons 'begin
+                          (for/list ([form (in-list (cdr b))])
+                            (decompile-form form globs stack closed stx-ht)))
+                    (list 'begin-for-syntax (loop (sub1 n))))))
           ,@(map (lambda (form)
                    (decompile-form form globs stack closed stx-ht))
                  body)))]
@@ -190,18 +194,19 @@
                                 (list-ref/protect (glob-desc-vars globs) pos 'def-vals)]))
                            ids)
         ,(decompile-expr rhs globs stack closed))]
-    [(struct def-syntaxes (ids rhs prefix max-let-depth))
+    [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
      `(define-syntaxes ,ids
         ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
            `(let ()
               ,@defns
               ,(decompile-form rhs globs '(#%globals) closed stx-ht))))]
-    [(struct def-for-syntax (ids rhs prefix max-let-depth))
-     `(define-values-for-syntax ,ids
-        ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
-           `(let ()
+    [(struct seq-for-syntax (exprs prefix max-let-depth dummy))
+     `(begin-for-syntax
+       ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
+          `(let ()
              ,@defns
-             ,(decompile-form rhs globs '(#%globals) closed stx-ht))))]
+             ,@(for/list ([rhs (in-list exprs)])
+                 (decompile-form rhs globs '(#%globals) closed stx-ht)))))]
     [(struct seq (forms))
      `(begin ,@(map (lambda (form)
                       (decompile-form form globs stack closed stx-ht))
diff --git a/collects/compiler/demodularizer/gc-toplevels.rkt b/collects/compiler/demodularizer/gc-toplevels.rkt
index 1118214a8e..f212b66081 100644
--- a/collects/compiler/demodularizer/gc-toplevels.rkt
+++ b/collects/compiler/demodularizer/gc-toplevels.rkt
@@ -64,7 +64,7 @@
        (build-graph! new-lhs rhs)]
       [(? def-syntaxes?)
        (error 'build-graph "Doesn't handle syntax")]
-      [(? def-for-syntax?)
+      [(? seq-for-syntax?)
        (error 'build-graph "Doesn't handle syntax")]
       [(struct req (reqs dummy))
        (build-graph! lhs dummy)]
@@ -197,7 +197,7 @@
            #f)]
       [(? def-syntaxes?)
        (error 'gc-tls "Doesn't handle syntax")]
-      [(? def-for-syntax?)
+      [(? seq-for-syntax?)
        (error 'gc-tls "Doesn't handle syntax")]
       [(struct req (reqs dummy))
        (make-req reqs (update dummy))]
diff --git a/collects/compiler/demodularizer/merge.rkt b/collects/compiler/demodularizer/merge.rkt
index 5c63e6d22b..6e57f5962c 100644
--- a/collects/compiler/demodularizer/merge.rkt
+++ b/collects/compiler/demodularizer/merge.rkt
@@ -108,7 +108,8 @@
 
 (define (merge-module max-let-depth top-prefix mod-form)
   (match mod-form
-    [(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-body unexported mod-max-let-depth dummy lang-info internal-context))
+    [(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-bodies
+                       unexported mod-max-let-depth dummy lang-info internal-context))
      (define toplevel-offset (length (prefix-toplevels top-prefix)))
      (define topsyntax-offset (length (prefix-stxs top-prefix)))
      (define lift-offset (prefix-num-lifts top-prefix))
diff --git a/collects/compiler/demodularizer/module.rkt b/collects/compiler/demodularizer/module.rkt
index 48253dd7e2..0bf82da22c 100644
--- a/collects/compiler/demodularizer/module.rkt
+++ b/collects/compiler/demodularizer/module.rkt
@@ -24,7 +24,7 @@
                 (list (cons 0 requires))
                 new-forms
                 empty ; syntax-body
-                (list empty empty empty) ; unexported
+                (list) ; unexported
                 max-let-depth
                 (make-toplevel 0 0 #f #f) ; dummy
                 lang-info
diff --git a/collects/compiler/demodularizer/nodep.rkt b/collects/compiler/demodularizer/nodep.rkt
index b9d7a8eb79..68cc899241 100644
--- a/collects/compiler/demodularizer/nodep.rkt
+++ b/collects/compiler/demodularizer/nodep.rkt
@@ -112,7 +112,8 @@
 
 (define (nodep-module mod-form phase)
   (match mod-form
-    [(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported max-let-depth dummy lang-info internal-context))
+    [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies
+                       unexported max-let-depth dummy lang-info internal-context))
      (define new-prefix prefix)
      ; Cache all the mpi paths
      (for-each (match-lambda
diff --git a/collects/compiler/demodularizer/update-toplevels.rkt b/collects/compiler/demodularizer/update-toplevels.rkt
index 90a7b8f2c2..15584bb5d3 100644
--- a/collects/compiler/demodularizer/update-toplevels.rkt
+++ b/collects/compiler/demodularizer/update-toplevels.rkt
@@ -10,7 +10,7 @@
                         (update rhs))]
       [(? def-syntaxes?)
        (error 'increment "Doesn't handle syntax")]
-      [(? def-for-syntax?)
+      [(? seq-for-syntax?)
        (error 'increment "Doesn't handle syntax")]
       [(struct req (reqs dummy))
        (make-req reqs (update dummy))]
diff --git a/collects/compiler/main.rkt b/collects/compiler/main.rkt
index f8df28abf7..e224a99385 100644
--- a/collects/compiler/main.rkt
+++ b/collects/compiler/main.rkt
@@ -510,7 +510,7 @@
    (parameterize ([compile-notify-handler 
                    (lambda (path)
                      (when (compiler:option:somewhat-verbose)
-                       (printf "  making ~s\n" (path->string path))))])
+                       (printf "  making ~s\n" path)))])
      (apply compile-collection-zos source-files))]
   [(cc)
    (for ([file source-files])
diff --git a/collects/compiler/private/mach-o.rkt b/collects/compiler/private/mach-o.rkt
index aee2b31617..45fe573a55 100644
--- a/collects/compiler/private/mach-o.rkt
+++ b/collects/compiler/private/mach-o.rkt
@@ -56,6 +56,7 @@
                  [link-edit-addr 0]
                  [link-edit-offset 0]
                  [link-edit-len 0]
+                 [link-edit-vmlen 0]
                  [dyld-info-pos #f]
                  [dyld-info-offs #f])
             ;; (printf "~a cmds, length 0x~x\n" cnt cmdssz)
@@ -82,6 +83,7 @@
                            (set! link-edit-64? 64?)
                            (set! link-edit-pos pos)
                            (set! link-edit-addr vmaddr)
+                           (set! link-edit-vmlen vmlen)
                            (set! link-edit-offset offset)
                            (set! link-edit-len len)
                            (when (link-edit-len . < . 0)
@@ -145,7 +147,7 @@
                   [out-offset (if move-link-edit?
                                   link-edit-offset
                                   (+ link-edit-offset (round-up-page link-edit-len)))]
-                  [out-addr (+ link-edit-addr (round-up-page link-edit-len))])
+                  [out-addr (+ link-edit-addr (round-up-page link-edit-vmlen))])
               (unless ((+ end-cmd new-cmd-sz) . < . min-used)
                 (error 'check-header 
                        "no room for a new section load command (current end is ~a; min used is ~a)"
diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt
index e435a97080..22f5d5b95e 100644
--- a/collects/compiler/zo-marshal.rkt
+++ b/collects/compiler/zo-marshal.rkt
@@ -158,7 +158,7 @@
 (define quote-syntax-type-num 14)
 (define define-values-type-num 15)
 (define define-syntaxes-type-num 16)
-(define define-for-syntax-type-num 17)
+(define begin-for-syntax-type-num 17)
 (define set-bang-type-num 18)
 (define boxenv-type-num 19)
 (define begin0-sequence-type-num 20)
@@ -256,8 +256,6 @@
 
 (define BITS_PER_MZSHORT 32)
 
-(define *dummy* #f)
-
 (define (int->bytes x)
   (integer->integer-bytes x
                           4
@@ -522,21 +520,20 @@
         (out-marshaled define-values-type-num
                        (list->vector (cons (protect-quote rhs) ids))
                        out)]
-       [(struct def-syntaxes (ids rhs prefix max-let-depth))
+       [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
         (out-marshaled define-syntaxes-type-num
                        (list->vector (list* (protect-quote rhs)
                                             prefix
                                             max-let-depth
-                                            *dummy*
+                                            dummy
                                             ids))
                        out)]
-       [(struct def-for-syntax (ids rhs prefix max-let-depth))
-        (out-marshaled define-for-syntax-type-num
-                       (list->vector (list* (protect-quote rhs)
-                                            prefix
-                                            max-let-depth
-                                            *dummy*
-                                            ids))
+       [(struct seq-for-syntax (rhs prefix max-let-depth dummy))
+        (out-marshaled begin-for-syntax-type-num
+                       (vector (map protect-quote rhs)
+                               prefix
+                               max-let-depth
+                               dummy)
                        out)]
        [(struct beg0 (forms))
         (out-marshaled begin0-sequence-type-num (map protect-quote forms) out)]
@@ -825,7 +822,7 @@
 
 (define (out-module mod-form out)
   (match mod-form
-    [(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported 
+    [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported 
                        max-let-depth dummy lang-info internal-context))
      (let* ([lookup-req (lambda (phase)
                           (let ([a (assq phase requires)])
@@ -844,6 +841,11 @@
                         (if (ormap values p)
                             (list->vector p)
                             #f)))))]
+            [extract-unexported
+             (lambda (phase)
+               (let ([a (assq phase unexported)])
+                 (and a
+                      (cdr a))))]
             [list->vector/#f (lambda (default l)
                                (if (andmap (lambda (x) (equal? x default)) l)
                                    #f
@@ -861,45 +863,54 @@
             [l (cons (lookup-req 1) l)] ; et-requires
             [l (cons (lookup-req 0) l)] ; requires
             [l (cons (list->vector body) l)]
-            [l (cons (list->vector
-                      (for/list ([i (in-list syntax-body)])
-                        (define (maybe-one l) ;; a single symbol is ok
-                          (if (and (pair? l) (null? (cdr l)))
-                              (car l)
-                              l))
-                        (match i
-                          [(struct def-syntaxes (ids rhs prefix max-let-depth))
-                           (vector (maybe-one ids) rhs max-let-depth prefix #f)]
-                          [(struct def-for-syntax (ids rhs prefix max-let-depth))
-                           (vector (maybe-one ids) rhs max-let-depth prefix #t)])))
-                     l)]
+            [l (append (reverse
+                        (for/list ([b (in-list syntax-bodies)])
+                          (for/vector ([i (in-list (cdr b))])
+                            (define (maybe-one l) ;; a single symbol is ok
+                              (if (and (pair? l) (null? (cdr l)))
+                                  (car l)
+                                  l))
+                            (match i
+                              [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
+                               (vector (maybe-one ids) rhs max-let-depth prefix #f)]
+                              [(struct seq-for-syntax ((list rhs) prefix max-let-depth dummy))
+                               (vector #f rhs max-let-depth prefix #t)]))))
+                       l)]
             [l (append (apply
                         append
                         (map (lambda (l)
-                               (let ([phase (car l)]
-                                     [all (append (cadr l) (caddr l))])
-                                 (list phase
-                                       (list->vector/#f 0 (map (lambda (p) (= 1 (provided-src-phase p))) 
-                                                               all))
-                                       (list->vector/#f #f (map (lambda (p)
-                                                                  (if (eq? (provided-nom-src p)
-                                                                           (provided-src p))
-                                                                      #f ; #f means "same as src"
-                                                                      (provided-nom-src p)))
-                                                                all))
-                                       (list->vector (map provided-src-name all))
-                                       (list->vector (map provided-src all))
-                                       (list->vector (map provided-name all))
-                                       (length (cadr l))
-                                       (length all))))
+                               (let* ([phase (car l)]
+                                      [all (append (cadr l) (caddr l))]
+                                      [protects (extract-protects phase)]
+                                      [unexported (extract-unexported phase)])
+                                 (append
+                                  (list phase)
+                                  (if (and (not protects) 
+                                           (not unexported))
+                                      (list (void))
+                                      (let ([unexported (or unexported
+                                                            '(() ()))])
+                                        (list (list->vector (cadr unexported))
+                                              (length (cadr unexported))
+                                              (list->vector (car unexported))
+                                              (length (car unexported))
+                                              protects)))
+                                  (list (list->vector/#f 0 (map provided-src-phase all))
+                                        (list->vector/#f #f (map (lambda (p)
+                                                                   (if (eq? (provided-nom-src p)
+                                                                            (provided-src p))
+                                                                       #f ; #f means "same as src"
+                                                                       (provided-nom-src p)))
+                                                                 all))
+                                        (list->vector (map provided-src-name all))
+                                        (list->vector (map provided-src all))
+                                        (list->vector (map provided-name all))
+                                        (length (cadr l))
+                                        (length all)))))
                              provides))
                        l)]
             [l (cons (length provides) l)] ; number of provide sets
-            [l (cons (extract-protects 0) l)] ; protects
-            [l (cons (extract-protects 1) l)] ; et protects
-            [l (list* (list->vector (car unexported)) (length (car unexported)) l)] ; indirect-provides
-            [l (list* (list->vector (cadr unexported)) (length (cadr unexported)) l)] ; indirect-syntax-provides
-            [l (list* (list->vector (caddr unexported)) (length (caddr unexported)) l)] ; indirect-et-provides
+            [l (cons (add1 (length syntax-bodies)) l)]
             [l (cons prefix l)]
             [l (cons dummy l)]
             [l (cons max-let-depth l)]
diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt
index 3c559ec62b..468c27fe21 100644
--- a/collects/compiler/zo-parse.rkt
+++ b/collects/compiler/zo-parse.rkt
@@ -181,19 +181,19 @@
    (cdr (vector->list v))
    (vector-ref v 0)))
 
-; XXX Allocates unnessary list
-(define (read-define-syntaxes mk v)
-  (mk (list-tail (vector->list v) 4)
-      (vector-ref v 0)
-      (vector-ref v 1)
-      (vector-ref v 2)
-      #;(vector-ref v 3)))
-
 (define (read-define-syntax v)
-  (read-define-syntaxes make-def-syntaxes v))
+  (make-def-syntaxes (list-tail (vector->list v) 4)
+                     (vector-ref v 0)
+                     (vector-ref v 1)
+                     (vector-ref v 2)
+                     (vector-ref v 3)))
 
-(define (read-define-for-syntax v)
-  (read-define-syntaxes make-def-for-syntax v))
+(define (read-begin-for-syntax v)
+  (make-seq-for-syntax 
+   (vector-ref v 0)
+   (vector-ref v 1)
+   (vector-ref v 2)
+   (vector-ref v 3)))
 
 (define (read-set! v)
   (make-assign (cadr v) (cddr v) (car v)))
@@ -225,50 +225,65 @@
              (lambda _ #t)
              (lambda _ #t)))))
 
+(define (split-phase-data rest n)
+  (let loop ([n n] [rest rest] [phase-accum null])
+    (cond
+     [(zero? n)
+      (values (reverse phase-accum) rest)]
+     [else
+      (let ([maybe-indirect (list-ref rest 1)])
+        (if (void? maybe-indirect) 
+            ;; no indirect or protect info:
+            (loop (sub1 n)
+                  (list-tail rest 9)
+                  (cons (take rest 9) phase-accum))
+            ;; has indirect or protect info:
+            (loop (sub1 n)
+                  (list-tail rest (+ 5 8))
+                  (cons (take rest (+ 5 8)) phase-accum))))])))
+      
 (define (read-module v)
   (match v
     [`(,name ,srcname ,self-modidx ,lang-info ,functional? ,et-functional?
              ,rename ,max-let-depth ,dummy
-             ,prefix
-             ,indirect-et-provides ,num-indirect-et-provides 
-             ,indirect-syntax-provides ,num-indirect-syntax-provides 
-             ,indirect-provides ,num-indirect-provides 
-             ,protects ,et-protects
+             ,prefix ,num-phases
              ,provide-phase-count . ,rest)
-     (let ([phase-data (take rest (* 8 provide-phase-count))])
-       (match (list-tail rest (* 8 provide-phase-count))
-         [`(,syntax-body ,body
-                         ,requires ,syntax-requires ,template-requires ,label-requires
-                         ,more-requires-count . ,more-requires)
+     (let*-values ([(phase-data rest-module) (split-phase-data rest provide-phase-count)]
+                   [(bodies rest-module) (values (take rest-module num-phases)
+                                                 (drop rest-module num-phases))])
+       (match rest-module
+         [`(,requires ,syntax-requires ,template-requires ,label-requires
+                      ,more-requires-count . ,more-requires)
           (make-mod name srcname self-modidx
-                    prefix (let loop ([l phase-data])
-                             (if (null? l)
-                                 null
-                                 (let ([num-vars (list-ref l 6)]
-                                       [ps (for/list ([name (in-vector (list-ref l 5))]
-                                                      [src (in-vector (list-ref l 4))]
-                                                      [src-name (in-vector (list-ref l 3))]
-                                                      [nom-src (or (list-ref l 2)
-                                                                   (in-cycle (in-value #f)))]
-                                                      [src-phase (or (list-ref l 1)
-                                                                     (in-cycle (in-value #f)))]
-                                                      [protected? (or (case (car l)
-                                                                        [(0) protects]
-                                                                        [(1) et-protects]
-                                                                        [else #f])
-                                                                      (in-cycle (in-value #f)))])
-                                             (make-provided name src src-name 
-                                                            (or nom-src src)
-                                                            (if src-phase 1 0)
-                                                            protected?))])
-                                   (if (null? ps)
-                                       (loop (list-tail l 8))
-                                       (cons
-                                        (list
-                                         (car l)
-                                         (take ps num-vars)
-                                         (drop ps num-vars))
-                                        (loop (list-tail l 8)))))))
+                    prefix
+                    ;; provides:
+                    (for/list ([l (in-list phase-data)])
+                      (let* ([phase (list-ref l 0)]
+                             [has-info? (not (void? (list-ref l 1)))]
+                             [delta (if has-info? 5 1)]
+                             [num-vars (list-ref l (+ delta 6))]
+                             [num-all (list-ref l (+ delta 7))]
+                             [ps (for/list ([name (in-vector (list-ref l (+ delta 5)))]
+                                            [src (in-vector (list-ref l (+ delta 4)))]
+                                            [src-name (in-vector (list-ref l (+ delta 3)))]
+                                            [nom-src (or (list-ref l (+ delta 2))
+                                                         (in-cycle (in-value #f)))]
+                                            [src-phase (or (list-ref l (+ delta 1))
+                                                           (in-cycle (in-value 0)))]
+                                            [protected? (cond
+                                                         [(or (not has-info?)
+                                                              (not (list-ref l 5)))
+                                                          (in-cycle (in-value #f))]
+                                                         [else (list-ref l 5)])])
+                                   (make-provided name src src-name 
+                                                  (or nom-src src)
+                                                  src-phase
+                                                  protected?))])
+                        (list
+                         phase
+                         (take ps num-vars)
+                         (drop ps num-vars))))
+                    ;; requires:
                     (list*
                      (cons 0 requires)
                      (cons 1 syntax-requires)
@@ -276,20 +291,34 @@
                      (cons #f label-requires)
                      (for/list ([(phase reqs) (in-list* more-requires 2)])
                        (cons phase reqs)))
-                    (vector->list body)
-                    (map (lambda (sb)
-                           (match sb
-                             [(? def-syntaxes?) sb]
-                             [(? def-for-syntax?) sb]
-                             [`#(,ids ,expr ,max-let-depth ,prefix ,for-stx?)
-                              ((if for-stx?
-                                   make-def-for-syntax
-                                   make-def-syntaxes)
-                               (if (list? ids) ids (list ids)) expr prefix max-let-depth)]))
-                         (vector->list syntax-body))
-                    (list (vector->list indirect-provides)
-                          (vector->list indirect-syntax-provides)
-                          (vector->list indirect-et-provides))
+                    ;; body:
+                    (vector->list (last bodies))
+                    ;; syntax-bodies: add phase to each list, break apart
+                    (for/list ([b (cdr (reverse bodies))]
+                               [i (in-naturals 1)])
+                      (cons i
+                            (for/list ([sb (in-vector b)])
+                              (match sb
+                                [`#(,ids ,expr ,max-let-depth ,prefix ,for-stx?)
+                                 (if for-stx?
+                                     (make-seq-for-syntax (list expr) prefix max-let-depth #f)
+                                     (make-def-syntaxes
+                                      (if (list? ids) ids (list ids)) expr prefix max-let-depth #f))]
+                                [else (error 'zo-parse "bad phase ~a body element: ~e" i sb)]))))
+                    ;; unexported:
+                    (for/list ([l (in-list phase-data)]
+                               #:when (not (void? (list-ref l 1))))
+                      (let* ([phase (list-ref l 0)]
+                             [indirect-syntax 
+                              ;; could check: (list-ref l 2) should be size of vector:
+                              (list-ref l 1)]
+                             [indirect 
+                              ;; could check: (list-ref l 4) should be size of vector:
+                              (list-ref l 3)])
+                        (list
+                         phase
+                         (vector->list indirect)
+                         (vector->list indirect-syntax))))
                     max-let-depth
                     dummy
                     lang-info
@@ -313,7 +342,7 @@
     [(14) 'quote-syntax-type]
     [(15) 'define-values-type]
     [(16) 'define-syntaxes-type]
-    [(17) 'define-for-syntax-type]
+    [(17) 'begin-for-syntax-type]
     [(18) 'set-bang-type]
     [(19) 'boxenv-type]
     [(20) 'begin0-sequence-type]
@@ -350,7 +379,7 @@
     (cons 'free-id-info-type read-free-id-info)
     (cons 'define-values-type read-define-values)
     (cons 'define-syntaxes-type read-define-syntax)
-    (cons 'define-for-syntax-type read-define-for-syntax)
+    (cons 'begin-for-syntax-type read-begin-for-syntax)
     (cons 'set-bang-type read-set!)
     (cons 'boxenv-type read-boxenv)
     (cons 'require-form-type read-require)
diff --git a/collects/compiler/zo-structs.rkt b/collects/compiler/zo-structs.rkt
index 86c8052a15..d1ed02537d 100644
--- a/collects/compiler/zo-structs.rkt
+++ b/collects/compiler/zo-structs.rkt
@@ -80,7 +80,7 @@
                               [src (or/c module-path-index? #f)] 
                               [src-name symbol?] 
                               [nom-src any/c] ; should be (or/c module-path-index? #f)
-                              [src-phase (or/c 0 1)] 
+                              [src-phase exact-nonnegative-integer?] 
                               [protected? boolean?]))
 
 (define-form-struct (toplevel expr) ([depth exact-nonnegative-integer?] 
@@ -89,18 +89,19 @@
                                      [ready? boolean?]))  ; access binding via prefix array (which is on stack)
 
 (define-form-struct (seq form) ([forms (listof (or/c form? any/c))])) ; `begin'
+(define-form-struct (seq-for-syntax form) ([forms (listof (or/c form? any/c))] ; `begin-for-syntax'
+                                           [prefix prefix?] 
+                                           [max-let-depth exact-nonnegative-integer?]
+                                           [dummy (or/c toplevel? #f)]))
 
 ;; Definitions (top level or within module):
-(define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol?
+(define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))]
                                        [rhs (or/c expr? seq? any/c)])) 
-(define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol?                                        
+(define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))]
                                          [rhs (or/c expr? seq? any/c)] 
                                          [prefix prefix?] 
-                                         [max-let-depth exact-nonnegative-integer?])) 
-(define-form-struct (def-for-syntax form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol?
-                                           [rhs (or/c expr? seq? any/c)] 
-                                           [prefix prefix?] 
-                                           [max-let-depth exact-nonnegative-integer?])) 
+                                         [max-let-depth exact-nonnegative-integer?]
+                                         [dummy (or/c toplevel? #f)]))
 
 (define-form-struct (mod form) ([name symbol?] 
                                 [srcname symbol?]
@@ -111,10 +112,12 @@
                                                           (listof provided?)))] 
                                 [requires (listof (cons/c (or/c exact-integer? #f)
                                                           (listof module-path-index?)))]
-                                [body (listof (or/c form? any/c))] 
-                                [syntax-body (listof (or/c def-syntaxes? def-for-syntax?))] 
-                                [unexported (list/c (listof symbol?) (listof symbol?)
-                                                    (listof symbol?))] 
+                                [body (listof (or/c form? any/c))]
+                                [syntax-bodies (listof (cons/c exact-positive-integer?
+                                                               (listof (or/c def-syntaxes? seq-for-syntax?))))]
+                                [unexported (listof (list/c exact-nonnegative-integer?
+                                                            (listof symbol?)
+                                                            (listof symbol?)))]
                                 [max-let-depth exact-nonnegative-integer?]
                                 [dummy toplevel?]
                                 [lang-info (or/c #f (vector/c module-path? symbol? any/c))]
diff --git a/collects/db/TODO b/collects/db/TODO
index b9af8c7f36..1c31fcc149 100644
--- a/collects/db/TODO
+++ b/collects/db/TODO
@@ -1,4 +1,3 @@
-internal docs
 ----
 
 Testing
@@ -31,11 +30,11 @@ Types
 
 Misc
 
+- internal docs
+
 - use ffi/unsafe/alloc to simplify odbc handle allocation
 
 - add ODBC-like functions for inspecting schemas (list-tables, etc)
-  - util/schema (?), util/info (for information_schema) (?)
-  - at least, table-exists? : string [...] -> boolean?
 
 - for wrapped/managed connections, detect if underlying connection gets
   disconnected by server (eg, times out after 10 minutes of inactivity)
@@ -67,10 +66,15 @@ Misc
   - how do people want to use cursors?
   - how about implicit support only in 'in-query'?
 
-- ODBC: use async execution to avoid blocking all Racket threads
-
 - add evt versions of functions
   - for query functions (?)
   - connection-pool-lease-evt
   - when is it useful in practice?
     - would make it easier to handle timeouts...
+
+- on insert, return last inserted id
+  - postgresql: parse CommandComplete msg tag
+  - mysql: in ok-packet (what conditions, though?)
+  - sqlite3: sqlite3_last_insert_rowid(), use sqlite3_changes() to see if insert succeeded,
+    but still need to tell if stmt was even insert (parse sql?)
+  - odbc: ???
diff --git a/collects/db/base.rkt b/collects/db/base.rkt
index 158b0a7093..fe626b3aa6 100644
--- a/collects/db/base.rkt
+++ b/collects/db/base.rkt
@@ -1,9 +1,250 @@
 #lang racket/base
 (require racket/contract
-         "private/generic/main.rkt"
-         "private/generic/connect-util.rkt"
-         "private/generic/dsn.rkt")
+         unstable/prop-contract)
 
-(provide (all-from-out "private/generic/main.rkt")
-         (all-from-out "private/generic/dsn.rkt")
-         (all-from-out "private/generic/connect-util.rkt"))
+;; ============================================================
+
+(require "private/generic/interfaces.rkt"
+         "private/generic/sql-data.rkt")
+
+(provide (struct-out simple-result)
+         (struct-out rows-result)
+         statement-binding?)
+
+(provide sql-null
+         sql-null?
+         sql-null->false
+         false->sql-null)
+
+(provide/contract
+ [struct sql-date ([year exact-integer?]
+                   [month (integer-in 0 12)]
+                   [day (integer-in 0 31)])]
+ [struct sql-time ([hour (integer-in 0 23)]
+                   [minute (integer-in 0 59)]
+                   [second (integer-in 0 61)] ;; leap seconds
+                   [nanosecond (integer-in 0 (sub1 #e1e9))]
+                   [tz (or/c #f exact-integer?)])]
+ [struct sql-timestamp ([year exact-integer?]
+                        [month (integer-in 0 12)]
+                        [day (integer-in 0 31)]
+                        [hour (integer-in 0 23)]
+                        [minute (integer-in 0 59)]
+                        [second (integer-in 0 61)]
+                        [nanosecond (integer-in 0 (sub1 #e1e9))]
+                        [tz (or/c #f exact-integer?)])]
+ [struct sql-interval ([years exact-integer?]
+                       [months exact-integer?]
+                       [days exact-integer?]
+                       [hours exact-integer?]
+                       [minutes exact-integer?]
+                       [seconds exact-integer?]
+                       [nanoseconds exact-integer?])]
+
+ [sql-day-time-interval?
+  (-> any/c boolean?)]
+ [sql-year-month-interval?
+  (-> any/c boolean?)]
+ [sql-interval->sql-time
+  (->* (sql-interval?) (any/c)
+       any)]
+ [sql-time->sql-interval
+  (-> sql-time? sql-day-time-interval?)]
+
+ [make-sql-bits
+  (-> exact-nonnegative-integer? sql-bits?)]
+ [sql-bits?
+  (-> any/c boolean?)]
+ [sql-bits-length
+  (-> sql-bits? exact-nonnegative-integer?)]
+ [sql-bits-ref
+  (-> sql-bits? exact-nonnegative-integer? boolean?)]
+ [sql-bits-set!
+  (-> sql-bits? exact-nonnegative-integer? boolean? void?)]
+ [sql-bits->list
+  (-> sql-bits? (listof boolean?))]
+ [list->sql-bits
+  (-> (listof boolean?) sql-bits?)]
+ [sql-bits->string
+  (-> sql-bits? string?)]
+ [string->sql-bits
+  (-> string? sql-bits?)])
+
+;; ============================================================
+
+(require "private/generic/functions.rkt")
+
+(provide (rename-out [in-query* in-query]))
+
+(provide/contract
+ [connection?
+  (-> any/c any)]
+ [disconnect
+  (-> connection? any)]
+ [connected?
+  (-> connection? any)]
+ [connection-dbsystem
+  (-> connection? dbsystem?)]
+ [dbsystem?
+  (-> any/c any)]
+ [dbsystem-name
+  (-> dbsystem? symbol?)]
+ [dbsystem-supported-types
+  (-> dbsystem? (listof symbol?))]
+
+ [statement?
+  (-> any/c any)]
+ [prepared-statement?
+  (-> any/c any)]
+ [prepared-statement-parameter-types
+  (-> prepared-statement? (or/c list? #f))]
+ [prepared-statement-result-types
+  (-> prepared-statement? (or/c list? #f))]
+
+ [query-exec
+  (->* (connection? statement?) () #:rest list? any)]
+ [query-rows
+  (->* (connection? statement?)
+       (#:group (or/c (vectorof string?) (listof (vectorof string?))))
+       #:rest list? (listof vector?))]
+ [query-list
+  (->* (connection? statement?) () #:rest list? list?)]
+ [query-row
+  (->* (connection? statement?) () #:rest list? vector?)]
+ [query-maybe-row
+  (->* (connection? statement?) () #:rest list? (or/c #f vector?))]
+ [query-value
+  (->* (connection? statement?) () #:rest list? any)]
+ [query-maybe-value
+  (->* (connection? statement?) () #:rest list? any)]
+ [query
+  (->* (connection? statement?) () #:rest list? any)]
+
+ [prepare
+  (-> connection? (or/c string? virtual-statement?) any)]
+ [bind-prepared-statement
+  (-> prepared-statement? list? any)]
+
+ [rename virtual-statement* virtual-statement
+  (-> (or/c string? (-> dbsystem? string?))
+      virtual-statement?)]
+ [virtual-statement?
+  (-> any/c boolean?)]
+
+ [start-transaction
+  (->* (connection?)
+       (#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
+       void?)]
+ [commit-transaction
+  (-> connection? void?)]
+ [rollback-transaction
+  (-> connection? void?)]
+ [in-transaction?
+  (-> connection? boolean?)]
+ [needs-rollback?
+  (-> connection? boolean?)]
+ [call-with-transaction
+  (->* (connection? (-> any))
+       (#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
+       void?)]
+
+ [prop:statement
+  (struct-type-property/c
+   (-> any/c connection?
+       statement?))]
+
+ [list-tables
+  (->* (connection?)
+       (#:schema (or/c 'search-or-current 'search 'current))
+       (listof string?))]
+ [table-exists?
+  (->* (connection? string?)
+       (#:schema (or/c 'search-or-current 'search 'current)
+        #:case-sensitive? any/c)
+       boolean?)]
+
+ [group-rows
+  (->* (rows-result?
+        #:group (or/c (vectorof string?) (listof (vectorof string?))))
+       (#:group-mode (listof (or/c 'preserve-null-rows 'list)))
+       rows-result?)])
+
+;; ============================================================
+
+(require "private/generic/connect-util.rkt")
+
+(provide/contract
+ [kill-safe-connection
+  (-> connection? connection?)]
+ [virtual-connection
+  (->* ((or/c (-> connection?) connection-pool?))
+       ()
+       connection?)]
+ [connection-pool
+  (->* ((-> connection?))
+       (#:max-connections (or/c (integer-in 1 10000) +inf.0)
+        #:max-idle-connections (or/c (integer-in 1 10000) +inf.0))
+       connection-pool?)]
+ [connection-pool?
+  (-> any/c boolean?)]
+ [connection-pool-lease
+  (->* (connection-pool?)
+       ((or/c custodian? evt?))
+       connection?)])
+
+;; ============================================================
+
+(require "private/generic/dsn.rkt")
+
+(provide dsn-connect)   ;; can't express "or any kw at all" w/ ->* contract
+(provide/contract
+ [struct data-source
+         ([connector connector?]
+          [args arglist?]
+          [extensions (listof (list/c symbol? writable-datum?))])]
+ [current-dsn-file (parameter/c path-string?)]
+ [get-dsn
+  (->* (symbol?) (any/c #:dsn-file path-string?) any)]
+ [put-dsn
+  (->* (symbol? (or/c data-source? #f)) (#:dsn-file path-string?) void?)]
+ [postgresql-data-source
+  (->* ()
+       (#:user string?
+        #:database string?
+        #:server string?
+        #:port exact-positive-integer?
+        #:socket (or/c string? 'guess)
+        #:password (or/c string? #f)
+        #:allow-cleartext-password? boolean?
+        #:ssl (or/c 'yes 'optional 'no)
+        #:notice-handler (or/c 'output 'error)
+        #:notification-handler (or/c 'output 'error))
+       data-source?)]
+ [mysql-data-source
+  (->* ()
+       (#:user string?
+        #:database string?
+        #:server string?
+        #:port exact-positive-integer?
+        #:socket (or/c string? 'guess)
+        #:password (or/c string? #f)
+        #:notice-handler (or/c 'output 'error))
+       data-source?)]
+ [sqlite3-data-source
+  (->* ()
+       (#:database (or/c string? 'memory 'temporary)
+        #:mode (or/c 'read-only 'read/write 'create)
+        #:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
+        #:busy-retry-delay (and/c rational? (not/c negative?))
+        #:use-place boolean?)
+       data-source?)]
+ [odbc-data-source
+  (->* ()
+       (#:dsn string?
+        #:user string?
+        #:password string?
+        #:notice-handler (or/c 'output 'error)
+        #:strict-parameter-types? boolean?
+        #:character-mode (or/c 'wchar 'utf-8 'latin-1)
+        #:use-place boolean?)
+       data-source?)])
diff --git a/collects/db/main.rkt b/collects/db/main.rkt
index 0a1a61ca12..3a852f1e54 100644
--- a/collects/db/main.rkt
+++ b/collects/db/main.rkt
@@ -1,39 +1,28 @@
 #lang racket/base
 (require (for-syntax racket/base)
-         "private/generic/lazy-require.rkt"
-         racket/runtime-path
-         racket/promise
+         unstable/lazy-require
          racket/contract
          "base.rkt")
 (provide (all-from-out "base.rkt"))
 
-(define-lazy-require-definer define-postgresql "private/postgresql/main.rkt")
-(define-lazy-require-definer define-mysql "private/mysql/main.rkt")
-(define-lazy-require-definer define-sqlite3 "private/sqlite3/main.rkt")
-(define-lazy-require-definer define-odbc "private/odbc/main.rkt")
-(define-lazy-require-definer define-openssl 'openssl)
-
-(define-postgresql
-  postgresql-connect
-  postgresql-guess-socket-path
-  postgresql-password-hash)
-
-(define-mysql
-  mysql-connect
-  mysql-guess-socket-path
-  mysql-password-hash)
-
-(define-sqlite3
-  sqlite3-connect)
-
-(define-odbc
-  odbc-connect
-  odbc-driver-connect
-  odbc-data-sources
-  odbc-drivers)
-
-(define-openssl
-  ssl-client-context?)
+(lazy-require
+ ["private/postgresql/main.rkt"
+  (postgresql-connect
+   postgresql-guess-socket-path
+   postgresql-password-hash)]
+ ["private/mysql/main.rkt"
+  (mysql-connect
+   mysql-guess-socket-path
+   mysql-password-hash)]
+ ["private/sqlite3/main.rkt"
+  (sqlite3-connect)]
+ ["private/odbc/main.rkt"
+  (odbc-connect
+   odbc-driver-connect
+   odbc-data-sources
+   odbc-drivers)]
+ ['openssl
+  (ssl-client-context?)])
 
 (provide/contract
  ;; Duplicates contracts at postgresql.rkt
@@ -49,7 +38,7 @@
         #:ssl-context ssl-client-context?
         #:notice-handler (or/c 'output 'error output-port? procedure?)
         #:notification-handler (or/c 'output 'error output-port? procedure?))
-       any/c)]
+       connection?)]
  [postgresql-guess-socket-path
   (-> path-string?)]
  [postgresql-password-hash
@@ -64,7 +53,7 @@
         #:port (or/c exact-positive-integer? #f)
         #:socket (or/c path-string? 'guess #f)
         #:notice-handler (or/c 'output 'error output-port? procedure?))
-       any/c)]
+       connection?)]
  [mysql-guess-socket-path
   (-> path-string?)]
  [mysql-password-hash
@@ -75,8 +64,9 @@
   (->* (#:database (or/c path-string? 'memory 'temporary))
        (#:mode (or/c 'read-only 'read/write 'create)
         #:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
-        #:busy-retry-delay (and/c rational? (not/c negative?)))
-       any/c)]
+        #:busy-retry-delay (and/c rational? (not/c negative?))
+        #:use-place boolean?)
+       connection?)]
 
  ;; Duplicates contracts at odbc.rkt
  [odbc-connect
@@ -85,13 +75,15 @@
         #:password (or/c string? #f)
         #:notice-handler (or/c 'output 'error output-port? procedure?)
         #:strict-parameter-types? boolean?
-        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
+        #:character-mode (or/c 'wchar 'utf-8 'latin-1)
+        #:use-place boolean?)
        connection?)]
  [odbc-driver-connect
   (->* (string?)
        (#:notice-handler (or/c 'output 'error output-port? procedure?)
         #:strict-parameter-types? boolean?
-        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
+        #:character-mode (or/c 'wchar 'utf-8 'latin-1)
+        #:use-place boolean?)
        connection?)]
  [odbc-data-sources
   (-> (listof (list/c string? string?)))]
diff --git a/collects/db/mysql.rkt b/collects/db/mysql.rkt
index 001cdfaade..ba78e4ce2c 100644
--- a/collects/db/mysql.rkt
+++ b/collects/db/mysql.rkt
@@ -13,7 +13,7 @@
         #:port (or/c exact-positive-integer? #f)
         #:socket (or/c path-string? 'guess #f)
         #:notice-handler (or/c 'output 'error output-port? procedure?))
-       any/c)]
+       connection?)]
  [mysql-guess-socket-path
   (-> path-string?)]
  [mysql-password-hash
diff --git a/collects/db/odbc.rkt b/collects/db/odbc.rkt
index 0e332f97a9..d1f752c962 100644
--- a/collects/db/odbc.rkt
+++ b/collects/db/odbc.rkt
@@ -11,13 +11,15 @@
         #:password (or/c string? #f)
         #:notice-handler (or/c 'output 'error output-port? procedure?)
         #:strict-parameter-types? boolean?
-        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
+        #:character-mode (or/c 'wchar 'utf-8 'latin-1)
+        #:use-place boolean?)
        connection?)]
  [odbc-driver-connect
   (->* (string?)
        (#:notice-handler (or/c 'output 'error output-port? procedure?)
         #:strict-parameter-types? boolean?
-        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
+        #:character-mode (or/c 'wchar 'utf-8 'latin-1)
+        #:use-place boolean?)
        connection?)]
  [odbc-data-sources
   (-> (listof (list/c string? string?)))]
diff --git a/collects/db/postgresql.rkt b/collects/db/postgresql.rkt
index 2830bce7c2..e36267e82f 100644
--- a/collects/db/postgresql.rkt
+++ b/collects/db/postgresql.rkt
@@ -18,7 +18,7 @@
         #:ssl-context ssl-client-context?
         #:notice-handler (or/c 'output 'error output-port? procedure?)
         #:notification-handler (or/c 'output 'error output-port? procedure?))
-       any/c)]
+       connection?)]
  [postgresql-guess-socket-path
   (-> path-string?)]
  [postgresql-password-hash
diff --git a/collects/db/private/generic/connect-util.rkt b/collects/db/private/generic/connect-util.rkt
index 9dc8cda696..87d23a0523 100644
--- a/collects/db/private/generic/connect-util.rkt
+++ b/collects/db/private/generic/connect-util.rkt
@@ -1,8 +1,11 @@
 #lang racket/base
-(require racket/contract
-         racket/class
-         "interfaces.rkt"
-         (only-in "functions.rkt" connection?))
+(require racket/class
+         "interfaces.rkt")
+(provide kill-safe-connection
+         virtual-connection
+         connection-pool
+         connection-pool?
+         connection-pool-lease)
 
 ;; manager% implements kill-safe manager thread w/ request channel
 (define manager%
@@ -22,7 +25,7 @@
            (loop)))))
 
     (define/public (call proc)
-      (thread-resume mthread)
+      (thread-resume mthread (current-thread))
       (let ([result #f]
             [sema (make-semaphore 0)])
         (channel-put req-channel
@@ -61,6 +64,7 @@
       (get-dbsystem)
       (query fsym stmt)
       (prepare fsym stmt close-on-exec?)
+      (get-base)
       (free-statement stmt)
       (transaction-status fsym)
       (start-transaction fsym isolation)
@@ -80,7 +84,7 @@
 ;; Virtual connection
 
 (define virtual-connection%
-  (class* object% (connection<%> no-cache-prepare<%>)
+  (class* object% (connection<%>)
     (init-private connector     ;; called from client thread
                   get-key       ;; called from client thread
                   timeout)
@@ -178,6 +182,9 @@
       (#f #f     (transaction-status fsym))
       (#t '_     (list-tables fsym schema)))
 
+    (define/public (get-base)
+      (get-connection #t))
+
     (define/public (disconnect)
       (let ([c (get-connection #f)]
             [key (get-key)])
@@ -187,7 +194,8 @@
       (void))
 
     (define/public (prepare fsym stmt close-on-exec?)
-      (unless close-on-exec?
+      ;; FIXME: hacky way of supporting virtual-statement
+      (unless (or close-on-exec? (eq? fsym 'virtual-statement))
         (error fsym "cannot prepare statement with virtual connection"))
       (send (get-connection #t) prepare fsym stmt close-on-exec?))
 
@@ -329,6 +337,7 @@
       (get-dbsystem)
       (query fsym stmt)
       (prepare fsym stmt close-on-exec?)
+      (get-base)
       (free-statement stmt)
       (transaction-status fsym)
       (start-transaction fsym isolation)
@@ -370,24 +379,3 @@
       (uerror 'connection-pool-lease
               "cannot obtain connection; connection pool limit reached"))
     result))
-
-;; ========================================
-
-(provide/contract
- [kill-safe-connection
-  (-> connection? connection?)]
- [virtual-connection
-  (->* ((or/c (-> connection?) connection-pool?))
-       ()
-       connection?)]
- [connection-pool
-  (->* ((-> connection?))
-       (#:max-connections (or/c (integer-in 1 10000) +inf.0)
-        #:max-idle-connections (or/c (integer-in 1 10000) +inf.0))
-       connection-pool?)]
- [connection-pool?
-  (-> any/c boolean?)]
- [connection-pool-lease
-  (->* (connection-pool?)
-       ((or/c custodian? evt?))
-       connection?)])
diff --git a/collects/db/private/generic/dsn.rkt b/collects/db/private/generic/dsn.rkt
index e2be89f92a..3100dc1490 100644
--- a/collects/db/private/generic/dsn.rkt
+++ b/collects/db/private/generic/dsn.rkt
@@ -1,20 +1,26 @@
 #lang racket/base
-(require "lazy-require.rkt"
-         racket/contract
+(require unstable/lazy-require
          racket/match
          racket/file
-         racket/list
-         racket/runtime-path
-         racket/promise
-         "main.rkt")
+         racket/list)
+(provide dsn-connect
+         (struct-out data-source)
+         connector?
+         arglist?
+         writable-datum?
+         current-dsn-file
+         get-dsn
+         put-dsn
+         postgresql-data-source
+         mysql-data-source
+         sqlite3-data-source
+         odbc-data-source)
 
-(define-lazy-require-definer define-main "../../main.rkt")
-
-(define-main
-  postgresql-connect
-  mysql-connect
-  sqlite3-connect
-  odbc-connect)
+(lazy-require
+ ["../../main.rkt" (postgresql-connect
+                    mysql-connect
+                    sqlite3-connect
+                    odbc-connect)])
 
 #|
 DSN v0.1 format
@@ -47,15 +53,15 @@ considered important.
 
 (define none (gensym 'none))
 
-(define (datum? x)
+(define (writable-datum? x)
   (or (symbol? x)
       (string? x)
       (number? x)
       (boolean? x)
       (null? x)
       (and (pair? x)
-           (datum? (car x))
-           (datum? (cdr x)))))
+           (writable-datum? (car x))
+           (writable-datum? (cdr x)))))
 
 (define (connector? x)
   (memq x '(postgresql mysql sqlite3 odbc)))
@@ -72,11 +78,11 @@ considered important.
                      (reverse kwargs))]
               [(keyword? (car x))
                (cond [(null? (cdr x)) (fail "keyword without argument: ~a" (car x))]
-                     [(datum? (cadr x))
+                     [(writable-datum? (cadr x))
                       (loop (cddr x) pargs (cons (list (car x) (cadr x)) kwargs))]
                      [else
                       (fail "expected readable datum: ~e" (cadr x))])]
-              [(datum? (car x))
+              [(writable-datum? (car x))
                (loop (cdr x) (cons (car x) pargs) kwargs)]
               [else (fail "expected readable datum: ~e" (car x))]))
       (fail "expected list")))
@@ -93,7 +99,7 @@ considered important.
     (if (list? x)
         (map (lambda (x)
                (match x
-                 [(list (? symbol? key) (? datum? value))
+                 [(list (? symbol? key) (? writable-datum? value))
                   x]
                  [else (fail "expected extension entry: ~e" x)]))
              x)
@@ -189,60 +195,9 @@ considered important.
 
 (define sqlite3-data-source
   (mk-specialized 'sqlite3-data-source 'sqlite3 0
-                  '(#:database #:mode #:busy-retry-limit #:busy-retry-delay)))
+                  '(#:database #:mode #:busy-retry-limit #:busy-retry-delay #:use-place)))
 
 (define odbc-data-source
   (mk-specialized 'odbc-data-source 'odbc 0
                   '(#:dsn #:user #:password #:notice-handler
-                    #:strict-parameter-types? #:character-mode)))
-
-(provide/contract
- [struct data-source
-         ([connector connector?]
-          [args arglist?]
-          [extensions (listof (list/c symbol? datum?))])]
- [dsn-connect procedure?] ;; Can't express "or any kw at all" w/ ->* contract.
- [current-dsn-file (parameter/c path-string?)]
- [get-dsn
-  (->* (symbol?) (any/c #:dsn-file path-string?) any)]
- [put-dsn
-  (->* (symbol? (or/c data-source? #f)) (#:dsn-file path-string?) void?)]
- [postgresql-data-source
-  (->* ()
-       (#:user string?
-        #:database string?
-        #:server string?
-        #:port exact-positive-integer?
-        #:socket (or/c string? 'guess)
-        #:password (or/c string? #f)
-        #:allow-cleartext-password? boolean?
-        #:ssl (or/c 'yes 'optional 'no)
-        #:notice-handler (or/c 'output 'error)
-        #:notification-handler (or/c 'output 'error))
-       data-source?)]
- [mysql-data-source
-  (->* ()
-       (#:user string?
-        #:database string?
-        #:server string?
-        #:port exact-positive-integer?
-        #:socket (or/c string? 'guess)
-        #:password (or/c string? #f)
-        #:notice-handler (or/c 'output 'error))
-       data-source?)]
- [sqlite3-data-source
-  (->* ()
-       (#:database (or/c string? 'memory 'temporary)
-        #:mode (or/c 'read-only 'read/write 'create)
-        #:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
-        #:busy-retry-delay (and/c rational? (not/c negative?)))
-       data-source?)]
- [odbc-data-source
-  (->* ()
-       (#:dsn string?
-        #:user string?
-        #:password string?
-        #:notice-handler (or/c 'output 'error)
-        #:strict-parameter-types? boolean?
-        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
-       data-source?)])
+                    #:strict-parameter-types? #:character-mode #:use-place)))
diff --git a/collects/db/private/generic/functions.rkt b/collects/db/private/generic/functions.rkt
index 50514edbef..54527bbe0e 100644
--- a/collects/db/private/generic/functions.rkt
+++ b/collects/db/private/generic/functions.rkt
@@ -1,9 +1,10 @@
 #lang racket/base
 (require (for-syntax racket/base)
-         racket/contract
-         unstable/prop-contract
+         racket/vector
          racket/class
-         "interfaces.rkt")
+         "interfaces.rkt"
+         (only-in "sql-data.rkt" sql-null sql-null?))
+(provide (all-defined-out))
 
 ;; == Administrative procedures
 
@@ -40,9 +41,6 @@
       (statement-binding? x)
       (prop:statement? x)))
 
-(define complete-statement?
-  (or/c string? statement-binding?))
-
 (define (bind-prepared-statement pst params)
   (send pst bind 'bind-prepared-statement params))
 
@@ -61,14 +59,16 @@
 (struct virtual-statement (table gen)
         #:property prop:statement
         (lambda (stmt c)
-          (let ([table (virtual-statement-table stmt)]
-                [gen (virtual-statement-gen stmt)]
-                [cache? (not (is-a? c no-cache-prepare<%>))])
-            (let ([table-pst (hash-ref table c #f)])
+          (let* ([table (virtual-statement-table stmt)]
+                 [gen (virtual-statement-gen stmt)]
+                 [base-c (send c get-base)])
+            (let ([table-pst (and base-c (hash-ref table base-c #f))])
               (or table-pst
                   (let* ([sql-string (gen (send c get-dbsystem))]
-                         [pst (prepare1 'virtual-statement c sql-string (not cache?))])
-                    (when cache? (hash-set! table c pst))
+                         ;; FIXME: virtual-connection:prepare1 handles
+                         ;; fsym = 'virtual-statement case specially
+                         [pst (prepare1 'virtual-statement c sql-string #f)])
+                    (hash-set! table base-c pst)
                     pst))))))
 
 (define virtual-statement*
@@ -84,7 +84,7 @@
 (define (query1 c fsym stmt)
   (send c query fsym stmt))
 
-;; query/rows : connection symbol Statement nat/#f -> void
+;; query/rows : connection symbol Statement nat/#f -> rows-result
 (define (query/rows c fsym sql want-columns)
   (let [(result (query1 c fsym sql))]
     (unless (rows-result? result)
@@ -135,9 +135,19 @@
 ;; Query API procedures
 
 ;; query-rows : connection Statement arg ... -> (listof (vectorof 'a))
-(define (query-rows c sql . args)
-  (let ([sql (compose-statement 'query-rows c sql args 'rows)])
-    (rows-result-rows (query/rows c 'query-rows sql #f))))
+(define (query-rows c sql
+                    #:group [group-fields-list null]
+                    #:group-mode [group-mode null]
+                    . args)
+  (let* ([sql (compose-statement 'query-rows c sql args 'rows)]
+         [result (query/rows c 'query-rows sql #f)]
+         [result
+          (cond [(not (null? group-fields-list))
+                 (group-rows-result* 'query-rows result group-fields-list
+                                     (not (memq 'preserve-null-rows group-mode))
+                                     (memq 'list group-mode))]
+                [else result])])
+    (rows-result-rows result)))
 
 ;; query-list : connection Statement arg ... -> (listof 'a)
 ;; Expects to get back a rows-result with one field per row.
@@ -292,103 +302,146 @@
 
 ;; ========================================
 
-(define preparable/c (or/c string? virtual-statement?))
+(define (group-rows result
+                    #:group key-fields-list
+                    #:group-mode [group-mode null])
+  (when (null? key-fields-list)
+    (error 'group-rows "expected at least one grouping field set"))
+  (group-rows-result* 'group-rows
+                      result
+                      key-fields-list
+                      (not (memq 'preserve-null-rows group-mode))
+                      (memq 'list group-mode)))
 
-(provide (rename-out [in-query* in-query]))
+(define (group-rows-result* fsym result key-fields-list invert-outer? as-list?)
+  (let* ([key-fields-list
+          (if (list? key-fields-list) key-fields-list (list key-fields-list))]
+         [total-fields (length (rows-result-headers result))]
+         [name-map
+          (for/hash ([header (in-list (rows-result-headers result))]
+                     [i (in-naturals)]
+                     #:when (assq 'name header))
+            (values (cdr (assq 'name header)) i))]
+         [fields-used (make-vector total-fields #f)]
+         [key-indexes-list
+          (for/list ([key-fields (in-list key-fields-list)])
+            (for/vector ([key-field (in-vector key-fields)])
+              (let ([key-index
+                     (cond [(string? key-field)
+                            (hash-ref name-map key-field #f)]
+                           [else key-field])])
+                (when (string? key-field)
+                  (unless key-index
+                    (error fsym "grouping field ~s not found" key-field)))
+                (when (exact-integer? key-field)
+                  (unless (< key-index total-fields)
+                    (error fsym "grouping index ~s out of range [0, ~a]"
+                           key-index (sub1 total-fields))))
+                (when (vector-ref fields-used key-index)
+                  (error fsym "grouping field ~s~a used multiple times"
+                         key-field
+                         (if (string? key-field)
+                             (format " (index ~a)" key-index)
+                             "")))
+                (vector-set! fields-used key-index #t)
+                key-index)))]
+         [residual-length
+          (for/sum ([x (in-vector fields-used)])
+            (if x 0 1))])
+    (when (= residual-length 0)
+      (error fsym "cannot group by all fields"))
+    (when (and (> residual-length 1) as-list?)
+      (error fsym
+             "exactly one residual field expected for #:group-mode 'list, got ~a"
+             residual-length))
+    (let* ([initial-projection
+            (for/vector #:length total-fields ([i (in-range total-fields)]) i)]
+           [headers
+            (group-headers (list->vector (rows-result-headers result))
+                           initial-projection
+                           key-indexes-list)]
+           [rows
+            (group-rows* fsym
+                         (rows-result-rows result)
+                         initial-projection
+                         key-indexes-list
+                         invert-outer?
+                         as-list?)])
+      (rows-result headers rows))))
 
-(provide/contract
- [connection?
-  (-> any/c any)]
- [disconnect
-  (-> connection? any)]
- [connected?
-  (-> connection? any)]
- [connection-dbsystem
-  (-> connection? dbsystem?)]
- [dbsystem?
-  (-> any/c any)]
- [dbsystem-name
-  (-> dbsystem? symbol?)]
- [dbsystem-supported-types
-  (-> dbsystem? (listof symbol?))]
+(define (group-headers headers projection key-indexes-list)
+  (define (get-headers vec)
+    (for/list ([index (in-vector vec)])
+      (vector-ref headers index)))
+  (cond [(null? key-indexes-list)
+         (get-headers projection)]
+        [else
+         (let* ([key-indexes (car key-indexes-list)]
+                [residual-projection
+                 (vector-filter-not (lambda (index) (vector-member index key-indexes))
+                                    projection)]
+                [residual-headers
+                 (group-headers headers residual-projection (cdr key-indexes-list))])
+           (append (get-headers key-indexes)
+                   (list `((grouped . ,residual-headers)))))]))
 
- [statement?
-  (-> any/c any)]
- [prepared-statement?
-  (-> any/c any)]
- [prepared-statement-parameter-types
-  (-> prepared-statement? (or/c list? #f))]
- [prepared-statement-result-types
-  (-> prepared-statement? (or/c list? #f))]
+(define (group-rows* fsym rows projection key-indexes-list invert-outer? as-list?)
+  ;; projection is vector of indexes (actually projection and permutation)
+  ;; invert-outer? => residual rows with all NULL fields are dropped.
+  (cond [(null? key-indexes-list)
+         ;; Apply projection to each row
+         (cond [as-list?
+                (unless (= (vector-length projection) 1)
+                  (error/internal
+                   fsym 
+                   "list mode requires a single residual column, got ~s"
+                   (vector-length projection)))
+                (let ([index (vector-ref projection 0)])
+                  (for/list ([row (in-list rows)])
+                    (vector-ref row index)))]
+               [else
+                (let ([plen (vector-length projection)])
+                  (for/list ([row (in-list rows)])
+                    (let ([v (make-vector plen)])
+                      (for ([i (in-range plen)])
+                        (vector-set! v i (vector-ref row (vector-ref projection i))))
+                      v)))])]
+        [else
+         (let ()
+           (define key-indexes (car key-indexes-list))
+           (define residual-projection
+             (vector-filter-not (lambda (index) (vector-member index key-indexes))
+                                projection))
 
- [query-exec
-  (->* (connection? statement?) () #:rest list? any)]
- [query-rows
-  (->* (connection? statement?) () #:rest list? (listof vector?))]
- [query-list
-  (->* (connection? statement?) () #:rest list? list?)]
- [query-row
-  (->* (connection? statement?) () #:rest list? vector?)]
- [query-maybe-row
-  (->* (connection? statement?) () #:rest list? (or/c #f vector?))]
- [query-value
-  (->* (connection? statement?) () #:rest list? any)]
- [query-maybe-value
-  (->* (connection? statement?) () #:rest list? any)]
- [query
-  (->* (connection? statement?) () #:rest list? any)]
+           (define key-row-length (vector-length key-indexes))
+           (define (row->key-row row)
+             (for/vector #:length key-row-length
+                         ([i (in-vector key-indexes)])
+                         (vector-ref row i)))
 
- #|
- [in-query
-  (->* (connection? statement?) () #:rest list? sequence?)]
- |#
+           (define (residual-all-null? row)
+             (for/and ([i (in-vector residual-projection)])
+                      (sql-null? (vector-ref row i))))
 
- [prepare
-  (-> connection? preparable/c any)]
- [bind-prepared-statement
-  (-> prepared-statement? list? any)]
-
- [rename virtual-statement* virtual-statement
-  (-> (or/c string? (-> dbsystem? string?))
-      virtual-statement?)]
- [virtual-statement?
-  (-> any/c boolean?)]
-
- [start-transaction
-  (->* (connection?)
-       (#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
-       void?)]
- [commit-transaction
-  (-> connection? void?)]
- [rollback-transaction
-  (-> connection? void?)]
- [in-transaction?
-  (-> connection? boolean?)]
- [needs-rollback?
-  (-> connection? boolean?)]
- [call-with-transaction
-  (->* (connection? (-> any))
-       (#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
-       void?)]
-
- [prop:statement
-  (struct-type-property/c
-   (-> any/c connection?
-       statement?))]
-
- [list-tables
-  (->* (connection?)
-       (#:schema (or/c 'search-or-current 'search 'current))
-       (listof string?))]
- [table-exists?
-  (->* (connection? string?)
-       (#:schema (or/c 'search-or-current 'search 'current)
-        #:case-sensitive? any/c)
-       boolean?)]
-
-#|
- [get-schemas
-  (-> connection? (listof vector?))]
- [get-tables
-  (-> connection? (listof vector?))]
-|#)
+           (let* ([key-table (make-hash)]
+                  [r-keys
+                   (for/fold ([r-keys null])
+                       ([row (in-list rows)])
+                     (let* ([key-row (row->key-row row)]
+                            [already-seen? (and (hash-ref key-table key-row #f) #t)])
+                       (unless already-seen?
+                         (hash-set! key-table key-row null))
+                       (unless (and invert-outer? (residual-all-null? row))
+                         (hash-set! key-table key-row (cons row (hash-ref key-table key-row))))
+                       (if already-seen?
+                           r-keys
+                           (cons key-row r-keys))))])
+             (for/list ([key (in-list (reverse r-keys))])
+               (let ([residuals
+                      (group-rows* fsym
+                                   (reverse (hash-ref key-table key))
+                                   residual-projection
+                                   (cdr key-indexes-list)
+                                   invert-outer?
+                                   as-list?)])
+                 (vector-append key (vector residuals))))))]))
diff --git a/collects/db/private/generic/interfaces.rkt b/collects/db/private/generic/interfaces.rkt
index 0fb17ebc46..73af6fba0f 100644
--- a/collects/db/private/generic/interfaces.rkt
+++ b/collects/db/private/generic/interfaces.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
-(require racket/class)
+(require racket/class
+         ffi/unsafe/atomic)
 (provide connection<%>
          dbsystem<%>
          prepared-statement<%>
@@ -13,9 +14,6 @@
 
          define-type-table
 
-         no-cache-prepare<%>
-         connector<%>
-
          locking%
          transactions%
 
@@ -42,21 +40,12 @@
     get-dbsystem  ;; -> dbsystem<%>
     query         ;; symbol statement -> QueryResult
     prepare       ;; symbol preparable boolean -> prepared-statement<%>
-
+    get-base      ;; -> connection<%> or #f (#f means base isn't fixed)
+    list-tables   ;; symbol symbol -> (listof string)
     start-transaction  ;; symbol (U 'serializable ...) -> void
     end-transaction    ;; symbol (U 'commit 'rollback) -> void
     transaction-status ;; symbol -> (U boolean 'invalid)
-
-    list-tables ;; symbol symbol -> (listof string)
-
-    free-statement)) ;; prepared-statement<%> -> void
-
-;; no-cache-prepare<%>
-;; Interface to identify connections such as connection-generators:
-;; prepare method must be called with close-on-exec? = #t and result must
-;; not be cached.
-(define no-cache-prepare<%>
-  (interface ()))
+    free-statement))   ;; prepared-statement<%> -> void
 
 ;; ==== DBSystem
 
@@ -102,7 +91,6 @@
 
     ;; extension hooks: usually shouldn't need to override
     finalize           ;; -> void
-    register-finalizer ;; -> void
 
     ;; inspection only
     get-param-types    ;; -> (listof TypeDesc)
@@ -176,16 +164,6 @@
         (list ok? t x)))))
 
 
-;; == Internal staging interfaces
-
-;; connector<%>
-;; Manages making connections
-(define connector<%>
-  (interface ()
-    attach-to-ports            ;; input-port output-port -> void
-    start-connection-protocol  ;; string string string/#f -> void
-    ))
-
 ;; == Notice/notification handler maker
 
 ;; make-handler : output-port/symbol string -> string string -> void
@@ -211,27 +189,33 @@
 
 ;; Connection base class (locking)
 
-;; Disabled for now, because this is an 80% solution. Unfortunately, I
-;; think a 100% solution would require an auxiliary kill-safe thread
-;; with multiple thread switches *per lock acquisition*. At that
-;; point, might as well just use kill-safe connection.
-(define USE-LOCK-HOLDER? #f)
-
 (define locking%
   (class object%
 
     ;; == Communication locking
 
-    (define lock (make-semaphore 1))
-
-    ;; Ideally, we would like to be able to detect if a thread has
+    ;; Goal: we would like to be able to detect if a thread has
     ;; acquired the lock and then died, leaving the connection
-    ;; permanently locked. Roughly, we would like this: if lock is
-    ;; held by thread th, then lock-holder = (thread-dead-evt th), 
-    ;; and if lock is not held, then lock-holder = never-evt.
-    ;; Unfortunately, there are intervals when this is not true.
-    ;; Also, since lock-holder changes, reference might be stale, so
-    ;; need to double-check.
+    ;; permanently locked.
+    ;;
+    ;; lock-holder=(thread-dead-evt thd) iff thd has acquired inner-lock
+    ;;  - lock-holder, inner-lock always modified together within
+    ;;    atomic block
+    ;;
+    ;; Thus if (thread-dead-evt thd) is ready, thd died holding
+    ;; inner-lock, so hopelessly locked.
+    ;;
+    ;; outer-sema = inner-lock
+    ;;  - outer-sema, inner-lock always modified together within atomic
+    ;;
+    ;; The outer-lock just prevents threads from spinning polling
+    ;; inner-lock. If a thread gets past outer-lock and dies before
+    ;; acquiring inner-lock, ok, because outer-lock still open at that
+    ;; point, so other threads can enter outer-lock and acquire inner-lock.
+
+    (define outer-sema (make-semaphore 1))
+    (define outer-lock (semaphore-peek-evt outer-sema))
+    (define inner-lock (make-semaphore 1))
     (define lock-holder never-evt)
 
     ;; Delay async calls (eg, notice handler) until unlock
@@ -243,21 +227,32 @@
       (call-with-lock* who proc #f #t))
 
     (define/public-final (call-with-lock* who proc hopeless require-connected?)
-      (let* ([me (thread-dead-evt (current-thread))]
-             [result (sync lock lock-holder)])
-        (cond [(eq? result lock)
-               ;; Acquired lock
-               (when USE-LOCK-HOLDER? (set! lock-holder me))
-               (when (and require-connected? (not (connected?)))
-                 (semaphore-post lock)
-                 (error/not-connected who))
-               (with-handlers ([values (lambda (e) (unlock) (raise e))])
-                 (begin0 (proc) (unlock)))]
+      (let ([me (thread-dead-evt (current-thread))]
+            [result (sync outer-lock lock-holder)])
+        (cond [(eq? result outer-lock)
+               ;; Got past outer stage
+               (let ([proceed?
+                      (begin (start-atomic)
+                             (let ([proceed? (semaphore-try-wait? inner-lock)])
+                               (when proceed?
+                                 (set! lock-holder me)
+                                 (semaphore-wait outer-sema))
+                               (end-atomic)
+                               proceed?))])
+                 (cond [proceed?
+                        ;; Acquired lock
+                        ;;  - lock-holder = me, and outer-lock is closed again
+                        (when (and require-connected? (not (connected?)))
+                          (unlock)
+                          (error/not-connected who))
+                        (with-handlers ([values (lambda (e) (unlock) (raise e))])
+                          (begin0 (proc) (unlock)))]
+                       [else
+                        ;; Didn't acquire lock; retry
+                        (call-with-lock* who proc hopeless require-connected?)]))]
               [(eq? result lock-holder)
                ;; Thread holding lock is dead
-               (if hopeless
-                   (hopeless)
-                   (error/hopeless who))]
+               (if hopeless (hopeless) (error/hopeless who))]
               [else
                ;; lock-holder was stale; retry
                (call-with-lock* who proc hopeless require-connected?)])))
@@ -265,8 +260,11 @@
     (define/private (unlock)
       (let ([async-calls (reverse delayed-async-calls)])
         (set! delayed-async-calls null)
-        (when USE-LOCK-HOLDER? (set! lock-holder never-evt))
-        (semaphore-post lock)
+        (start-atomic)
+        (set! lock-holder never-evt)
+        (semaphore-post inner-lock)
+        (semaphore-post outer-sema)
+        (end-atomic)
         (for-each call-with-continuation-barrier async-calls)))
 
     ;; needs overriding
diff --git a/collects/db/private/generic/lazy-require.rkt b/collects/db/private/generic/lazy-require.rkt
deleted file mode 100644
index 2b217a6ad2..0000000000
--- a/collects/db/private/generic/lazy-require.rkt
+++ /dev/null
@@ -1,38 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base)
-         racket/runtime-path
-         racket/promise)
-(provide define-lazy-require-definer)
-
-(define-syntax (define-lazy-require-definer stx)
-  (syntax-case stx ()
-    [(_ name modpath)
-     (begin
-       (unless (identifier? #'name)
-         (raise-syntax-error #f "expected identifier" stx #'name))
-       #'(begin (define-runtime-module-path-index mpi-var modpath)
-                (define-syntax name (make-lazy-require-definer #'mpi-var))))]))
-
-(define-for-syntax (make-lazy-require-definer mpi-var)
-  (lambda (stx)
-    (syntax-case stx ()
-      [(_ fun ...)
-       (begin
-         (for ([fun (in-list (syntax->list #'(fun ...)))])
-           (unless (identifier? fun)
-             (raise-syntax-error #f "expected identifier for function name" stx fun)))
-         (with-syntax ([(fun-p ...) (generate-temporaries #'(fun ...))]
-                       [mpi-var mpi-var])
-           ;; Use 'delay/sync' because 'delay' promise is not reentrant.
-           ;; FIXME: OTOH, 'delay/sync' promise is not kill-safe.
-           #'(begin (define fun-p (delay/sync (dynamic-require mpi-var 'fun)))
-                    ...
-                    (define fun (make-delayed-function 'fun fun-p))
-                    ...)))])))
-
-(define (make-delayed-function name fun-p)
-  (procedure-rename
-   (make-keyword-procedure
-    (lambda (kws kwargs . args)
-      (keyword-apply (force fun-p) kws kwargs args)))
-   name))
diff --git a/collects/db/private/generic/main.rkt b/collects/db/private/generic/main.rkt
deleted file mode 100644
index 505209c3c1..0000000000
--- a/collects/db/private/generic/main.rkt
+++ /dev/null
@@ -1,68 +0,0 @@
-#lang racket/base
-(require racket/contract
-         "interfaces.rkt"
-         "sql-data.rkt"
-         "functions.rkt")
-(provide (struct-out simple-result)
-         (struct-out rows-result)
-         statement-binding?
-         (all-from-out "functions.rkt"))
-
-(provide sql-null
-         sql-null?
-         sql-null->false
-         false->sql-null)
-
-(provide/contract
- [struct sql-date ([year exact-integer?]
-                   [month (integer-in 0 12)]
-                   [day (integer-in 0 31)])]
- [struct sql-time ([hour (integer-in 0 23)]
-                   [minute (integer-in 0 59)]
-                   [second (integer-in 0 61)] ;; leap seconds
-                   [nanosecond (integer-in 0 (sub1 #e1e9))]
-                   [tz (or/c #f exact-integer?)])]
- [struct sql-timestamp ([year exact-integer?]
-                        [month (integer-in 0 12)]
-                        [day (integer-in 0 31)]
-                        [hour (integer-in 0 23)]
-                        [minute (integer-in 0 59)]
-                        [second (integer-in 0 61)]
-                        [nanosecond (integer-in 0 (sub1 #e1e9))]
-                        [tz (or/c #f exact-integer?)])]
- [struct sql-interval ([years exact-integer?]
-                       [months exact-integer?]
-                       [days exact-integer?]
-                       [hours exact-integer?]
-                       [minutes exact-integer?]
-                       [seconds exact-integer?]
-                       [nanoseconds exact-integer?])]
-
- [sql-day-time-interval?
-  (-> any/c boolean?)]
- [sql-year-month-interval?
-  (-> any/c boolean?)]
- [sql-interval->sql-time
-  (->* (sql-interval?) (any/c)
-       any)]
- [sql-time->sql-interval
-  (-> sql-time? sql-day-time-interval?)]
-
- [make-sql-bits
-  (-> exact-nonnegative-integer? sql-bits?)]
- [sql-bits?
-  (-> any/c boolean?)]
- [sql-bits-length
-  (-> sql-bits? exact-nonnegative-integer?)]
- [sql-bits-ref
-  (-> sql-bits? exact-nonnegative-integer? boolean?)]
- [sql-bits-set!
-  (-> sql-bits? exact-nonnegative-integer? boolean? void?)]
- [sql-bits->list
-  (-> sql-bits? (listof boolean?))]
- [list->sql-bits
-  (-> (listof boolean?) sql-bits?)]
- [sql-bits->string
-  (-> sql-bits? string?)]
- [string->sql-bits
-  (-> string? sql-bits?)])
diff --git a/collects/db/private/generic/place-client.rkt b/collects/db/private/generic/place-client.rkt
new file mode 100644
index 0000000000..3f51cca579
--- /dev/null
+++ b/collects/db/private/generic/place-client.rkt
@@ -0,0 +1,107 @@
+#lang racket/base
+(require racket/class
+         racket/match
+         racket/place
+         racket/promise
+         racket/vector
+         racket/serialize
+         ffi/unsafe/atomic
+         "interfaces.rkt"
+         "prepared.rkt"
+         "sql-data.rkt")
+(provide place-connect
+         place-proxy-connection%)
+
+(define (pchan-put chan datum)
+  (place-channel-put chan (serialize datum)))
+(define (pchan-get chan)
+  (deserialize (place-channel-get chan)))
+
+(define connection-server-channel
+  (delay/sync
+   (dynamic-place 'db/private/generic/place-server 'connection-server)))
+
+(define (place-connect connection-spec proxy%)
+  (let-values ([(channel other-channel) (place-channel)])
+    (place-channel-put (force connection-server-channel)
+                       (list 'connect other-channel connection-spec))
+    (match (pchan-get channel)
+      [(list 'ok)
+       (new proxy% (channel channel))]
+      [(list 'error message)
+       (raise (make-exn:fail message (current-continuation-marks)))])))
+
+(define place-proxy-connection%
+  (class* locking% (connection<%>)
+    (init-field channel)
+    (inherit call-with-lock
+             call-with-lock*)
+    (super-new)
+
+    (define/private (call method-name . args)
+      (call-with-lock method-name (lambda () (call* method-name args #t))))
+    (define/private (call/d method-name . args)
+      (call-with-lock* method-name (lambda () (call* method-name args #f)) #f #f))
+    (define/private (call* method-name args need-connected?)
+      (cond [channel
+             (pchan-put channel (cons method-name args))
+             (match (pchan-get channel)
+               [(cons 'values vals)
+                (apply values (for/list ([val (in-list vals)]) (sexpr->result val)))]
+               [(list 'error message)
+                (raise (make-exn:fail message (current-continuation-marks)))])]
+            [need-connected?
+             (unless channel
+               (error/not-connected method-name))]
+            [else (void)]))
+
+    (define/override (connected?)
+      ;; FIXME: can underlying connection disconnect w/o us knowing?
+      (and channel #t))
+
+    (define/public (disconnect)
+      (call/d 'disconnect)
+      (set! channel #f))
+
+    (define/public (get-dbsystem) (error 'get-dbsystem "not implemented"))
+    (define/public (get-base) this)
+
+    (define/public (query fsym stmt)
+      (call 'query fsym
+            (match stmt
+              [(? string?) (list 'string stmt)]
+              [(statement-binding pst meta params)
+               (list 'statement-binding (send pst get-handle) meta params)])))
+    (define/public (prepare fsym stmt close-on-exec?)
+      (call 'prepare fsym stmt close-on-exec?))
+    (define/public (transaction-status fsym)
+      (call 'transaction-status fsym))
+    (define/public (start-transaction fsym iso)
+      (call 'start-transaction fsym iso))
+    (define/public (end-transaction fsym mode)
+      (call 'end-transaction fsym mode))
+    (define/public (list-tables fsym schema)
+      (call 'list-tables fsym schema))
+
+    (define/public (free-statement pst)
+      (start-atomic)
+      (let ([handle (send pst get-handle)])
+        (send pst set-handle #f)
+        (end-atomic)
+        (when channel
+          (call/d 'free-statement handle))))
+
+    (define/private (sexpr->result x)
+      (match x
+        [(list 'simple-result y)
+         (simple-result y)]
+        [(list 'rows-result h rows)
+         (rows-result h rows)]
+        [(list 'prepared-statement handle close-on-exec? param-typeids result-dvecs)
+         (new prepared-statement%
+              (handle handle)
+              (close-on-exec? close-on-exec?)
+              (param-typeids param-typeids)
+              (result-dvecs result-dvecs)
+              (owner this))]
+        [_ x]))))
diff --git a/collects/db/private/generic/place-server.rkt b/collects/db/private/generic/place-server.rkt
new file mode 100644
index 0000000000..155007cd95
--- /dev/null
+++ b/collects/db/private/generic/place-server.rkt
@@ -0,0 +1,142 @@
+#lang racket/base
+(require (for-syntax racket/base)
+         racket/class
+         racket/match
+         racket/place
+         racket/serialize
+         unstable/lazy-require
+         "interfaces.rkt"
+         "prepared.rkt"
+         "sql-data.rkt"
+         "place-client.rkt")
+(provide connection-server)
+
+(define (pchan-put chan datum)
+  (place-channel-put chan (serialize datum)))
+(define (pchan-get chan)
+  (deserialize (place-channel-get chan)))
+
+#|
+Connection creation protocol
+
+client -> server on client-chan: (list 'connect conn-chan <connect-options>)
+server -> client on conn-chan:   (or (list 'ok)
+                                     (list 'error string))
+
+where <connect-spec> ::= (list 'sqlite3 path/sym mode-sym delay-num limit-num)
+                      |  (list 'odbc string string/#f string/#f boolean symbol)
+|#
+(define (connection-server client-chan)
+  (let loop ()
+    (serve client-chan)
+    (loop)))
+
+(lazy-require
+ ["../../main.rkt" (sqlite3-connect
+                    odbc-connect
+                    odbc-driver-connect)])
+
+(define (serve client-chan)
+  (match (place-channel-get client-chan)
+    [(list 'connect conn-chan connect-spec)
+     (with-handlers ([exn:fail?
+                      (lambda (e)
+                        (pchan-put conn-chan (list 'error (exn-message e))))])
+       (let* ([c
+               (match connect-spec
+                 [(list 'sqlite3 db mode busy-retry-delay busy-retry-limit)
+                  (sqlite3-connect #:database db
+                                   #:mode mode
+                                   #:busy-retry-delay busy-retry-delay
+                                   #:busy-retry-limit busy-retry-limit
+                                   #:use-place #f)]
+                 [(list 'odbc dsn user password strict-param? char-mode)
+                  (odbc-connect #:dsn dsn
+                                #:user user
+                                #:password password
+                                #:strict-parameter-types? strict-param?
+                                #:character-mode char-mode
+                                #:use-place #f)]
+                 [(list 'odbc-driver connection-string strict-param? char-mode)
+                  (odbc-driver-connect connection-string
+                                       #:strict-parameter-types? strict-param?
+                                       #:character-mode char-mode
+                                       #:use-place #f)])]
+              [p (new proxy-server% (connection c) (channel conn-chan))])
+         (pchan-put conn-chan (list 'ok))
+         (thread (lambda () (send p serve)))))]))
+
+#|
+Connection methods protocol
+
+client -> server: (list '<method-name> arg ...)
+server -> client: (or (list 'values result ...)
+                      (list 'error string))
+|#
+
+(define proxy-server%
+  (class object%
+    (init-field connection
+                channel)
+    (super-new)
+
+    (define pstmt-table (make-hash)) ;; int => prepared-statement
+    (define pstmt-counter 0)
+
+    (define/public (serve)
+      (serve1)
+      (when connection (serve)))
+
+    (define/private (serve1)
+      (with-handlers ([exn?
+                       (lambda (e)
+                         (pchan-put channel (list 'error (exn-message e))))])
+        (call-with-values
+            (lambda ()
+              (match (pchan-get channel)
+                [(list 'disconnect)
+                 (send connection disconnect)
+                 (set! connection #f)]
+                [(list 'free-statement pstmt-index)
+                 (send connection free-statement (hash-ref pstmt-table pstmt-index))
+                 (hash-remove! pstmt-table pstmt-index)]
+                [(list 'query fsym stmt)
+                 (send connection query fsym (sexpr->statement stmt))]
+                [msg
+                 (define-syntax-rule (forward-methods (method arg ...) ...)
+                   (match msg
+                     [(list 'method arg ...)
+                      (send connection method arg ...)]
+                     ...))
+                 (forward-methods (connected?)
+                                  (prepare w s m)
+                                  (list-tables w s)
+                                  (start-transaction w m)
+                                  (end-transaction w m)
+                                  (transaction-status w))]))
+          (lambda results
+            (let ([results (for/list ([result (in-list results)]) (result->sexpr result))])
+              (pchan-put channel (cons 'values results)))))))
+
+    (define/private (sexpr->statement x)
+      (match x
+        [(list 'string s) s]
+        [(list 'statement-binding pstmt-index meta args)
+         (statement-binding (hash-ref pstmt-table pstmt-index) meta args)]))
+
+    (define/private (result->sexpr x)
+      (match x
+        [(simple-result y)
+         (list 'simple-result y)]
+        [(rows-result h rows)
+         (list 'rows-result h rows)]
+        ;; FIXME: Assumes prepared-statement is concrete class, not interface.
+        [(? (lambda (x) (is-a? x prepared-statement%)))
+         (let ([pstmt-index (begin (set! pstmt-counter (add1 pstmt-counter)) pstmt-counter)])
+           (hash-set! pstmt-table pstmt-index x)
+           (list 'prepared-statement
+                 pstmt-index
+                 (get-field close-on-exec? x)
+                 (get-field param-typeids x)
+                 (get-field result-dvecs x)))]
+        [_ x]))))
diff --git a/collects/db/private/generic/prepared.rkt b/collects/db/private/generic/prepared.rkt
index e5b6506051..8c9ed4bffa 100644
--- a/collects/db/private/generic/prepared.rkt
+++ b/collects/db/private/generic/prepared.rkt
@@ -8,10 +8,10 @@
 ;; prepared-statement%
 (define prepared-statement%
   (class* object% (prepared-statement<%>)
-    (init-private handle            ;; handle, determined by database system, #f means closed
-                  close-on-exec?    ;; boolean
-                  param-typeids     ;; (listof typeid)
-                  result-dvecs)     ;; (listof vector), layout depends on dbsys
+    (init-field handle            ;; handle, determined by database system, #f means closed
+                close-on-exec?    ;; boolean
+                param-typeids     ;; (listof typeid)
+                result-dvecs)     ;; (listof vector), layout depends on dbsys
     (init ([-owner owner]))
 
     (define owner (make-weak-box -owner))
@@ -81,7 +81,7 @@
           (send owner free-statement this))))
 
     (define/public (register-finalizer)
-      (thread-resume finalizer-thread)
+      (thread-resume finalizer-thread (current-thread))
       (will-register will-executor this (lambda (pst) (send pst finalize))))
 
     (super-new)
diff --git a/collects/db/private/generic/sql-convert.rkt b/collects/db/private/generic/sql-convert.rkt
index ac6eac4dc8..897a7e1742 100644
--- a/collects/db/private/generic/sql-convert.rkt
+++ b/collects/db/private/generic/sql-convert.rkt
@@ -1,5 +1,4 @@
 #lang racket/base
-(require "sql-data.rkt")
 
 ;; ========================================
 
diff --git a/collects/db/private/generic/sql-data.rkt b/collects/db/private/generic/sql-data.rkt
index 6336173377..732972fd64 100644
--- a/collects/db/private/generic/sql-data.rkt
+++ b/collects/db/private/generic/sql-data.rkt
@@ -1,4 +1,5 @@
 #lang racket/base
+(require racket/serialize)
 (provide (all-defined-out))
 
 ;; SQL Data
@@ -10,8 +11,15 @@
 
 (define sql-null
   (let ()
-    (define-struct sql-null ())
-    (make-sql-null)))
+    (struct sql-null ()
+            ;; must deserialize to singleton, so can't just use serializable-struct
+            #:property prop:serializable
+            (make-serialize-info (lambda _ '#())
+                                 #'deserialize-info:sql-null-v0
+                                 #f
+                                 (or (current-load-relative-directory)
+                                     (current-directory))))
+    (sql-null)))
 
 (define (sql-null? x)
   (eq? x sql-null))
@@ -26,6 +34,11 @@
       sql-null
       x))
 
+(define deserialize-info:sql-null-v0
+  (make-deserialize-info
+   (lambda _ sql-null)
+   (lambda () (error 'deserialize-sql-null "cannot have cycles"))))
+
 ;; ----------------------------------------
 
 ;; Dates and times
@@ -44,15 +57,15 @@
  - timezone offset too limited
 |#
 
-(define-struct sql-date (year month day) #:transparent)
-(define-struct sql-time (hour minute second nanosecond tz) #:transparent)
-(define-struct sql-timestamp
+(define-serializable-struct sql-date (year month day) #:transparent)
+(define-serializable-struct sql-time (hour minute second nanosecond tz) #:transparent)
+(define-serializable-struct sql-timestamp
   (year month day hour minute second nanosecond tz) 
   #:transparent)
 
 ;; Intervals must be "pre-multiplied" rather than carry extra sign field.
 ;; Rationale: postgresql, at least, allows mixture of signs, eg "1 month - 30 days"
-(define-struct sql-interval
+(define-serializable-struct sql-interval
   (years months days hours minutes seconds nanoseconds)
   #:transparent
   #:guard (lambda (years months days hours minutes seconds nanoseconds _name)
@@ -131,7 +144,7 @@ byte. (Because that's PostgreSQL's binary format.) For example:
 
   (bytes 128 3) represents 1000000 0000011
 |#
-(struct sql-bits (length bv offset))
+(serializable-struct sql-bits (length bv offset))
 
 (define (make-sql-bits len)
   (sql-bits len (make-bytes (/ceiling len 8) 0) 0))
diff --git a/collects/db/private/mysql/connection.rkt b/collects/db/private/mysql/connection.rkt
index a1fa843c93..78848a4d99 100644
--- a/collects/db/private/mysql/connection.rkt
+++ b/collects/db/private/mysql/connection.rkt
@@ -356,6 +356,8 @@
           [(? field-packet?)
            (cons (parse-field-dvec r) (prepare1:get-field-descriptions fsym))])))
 
+    (define/public (get-base) this)
+
     (define/public (free-statement pst)
       (call-with-lock* 'free-statement
         (lambda ()
diff --git a/collects/db/private/mysql/main.rkt b/collects/db/private/mysql/main.rkt
index 80d142e2be..e03057c8c3 100644
--- a/collects/db/private/mysql/main.rkt
+++ b/collects/db/private/mysql/main.rkt
@@ -1,16 +1,13 @@
 #lang racket/base
-(require racket/contract
-         racket/class
+(require racket/class
          racket/tcp
          file/sha1
          "../generic/interfaces.rkt"
          "../generic/socket.rkt"
-         "connection.rkt"
-         "dbsystem.rkt")
+         "connection.rkt")
 (provide mysql-connect
          mysql-guess-socket-path
-         mysql-password-hash
-         (rename-out [dbsystem mysql-dbsystem]))
+         mysql-password-hash)
 
 (define (mysql-connect #:user user
                        #:database database
diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt
index 6dc463463a..486022f8f0 100644
--- a/collects/db/private/odbc/connection.rkt
+++ b/collects/db/private/odbc/connection.rkt
@@ -3,6 +3,7 @@
          racket/list
          racket/math
          ffi/unsafe
+         ffi/unsafe/atomic
          "../generic/interfaces.rkt"
          "../generic/prepared.rkt"
          "../generic/sql-data.rkt"
@@ -24,7 +25,7 @@
                   char-mode)
     (init strict-parameter-types?)
 
-    (define statement-table (make-weak-hasheq))
+    (define statement-table (make-hasheq))
     (define lock (make-semaphore 1))
 
     (define use-describe-param?
@@ -437,13 +438,14 @@
 
     (define/public (disconnect)
       (define (go)
+        (start-atomic)
         (let ([db* db]
               [env* env])
+          (set! db #f)
+          (set! env #f)
+          (end-atomic)
           (when db*
             (let ([statements (hash-map statement-table (lambda (k v) k))])
-              (set! db #f)
-              (set! env #f)
-              (set! statement-table #f)
               (for ([pst (in-list statements)])
                 (free-statement* 'disconnect pst))
               (handle-status 'disconnect (SQLDisconnect db*) db*)
@@ -452,16 +454,21 @@
               (void)))))
       (call-with-lock* 'disconnect go go #f))
 
+    (define/public (get-base) this)
+
     (define/public (free-statement pst)
       (define (go) (free-statement* 'free-statement pst))
       (call-with-lock* 'free-statement go go #f))
 
     (define/private (free-statement* fsym pst)
+      (start-atomic)
       (let ([stmt (send pst get-handle)])
+        (send pst set-handle #f)
+        (end-atomic)
         (when stmt
-          (send pst set-handle #f)
           (handle-status 'free-statement (SQLFreeStmt stmt SQL_CLOSE) stmt)
           (handle-status 'free-statement (SQLFreeHandle SQL_HANDLE_STMT stmt) stmt)
+          (hash-remove! statement-table pst)
           (void))))
 
     ;; Transactions
@@ -654,3 +661,19 @@
 
 (define (field-dvec->typeid dvec)
   (vector-ref dvec 1))
+
+#|
+Historical note: I tried using ODBC async execution to avoid blocking
+all Racket threads for a long time.
+
+1) The postgresql, mysql, and oracle drivers don't even support async
+execution. Only DB2 (and probably SQL Server, but I didn't try it).
+
+2) Tests using the DB2 driver gave bafflind HY010 (function sequence
+error). My best theory so far is that DB2 (or maybe unixodbc) requires
+poll call arguments to be identical to original call arguments, which
+means that I would have to replace all uses of (_ptr o X) with
+something stable across invocations.
+
+All in all, not worth it, especially given #:use-place solution.
+|#
diff --git a/collects/db/private/odbc/dbsystem.rkt b/collects/db/private/odbc/dbsystem.rkt
index f6ade4e336..bbef44b51d 100644
--- a/collects/db/private/odbc/dbsystem.rkt
+++ b/collects/db/private/odbc/dbsystem.rkt
@@ -1,11 +1,8 @@
 #lang racket/base
 (require racket/class
-         ffi/unsafe
-         ffi/unsafe/atomic
          "../generic/interfaces.rkt"
          "../generic/sql-data.rkt"
-         "../generic/sql-convert.rkt"
-         "ffi.rkt")
+         "../generic/sql-convert.rkt")
 (provide dbsystem
          supported-typeid?)
 
diff --git a/collects/db/private/odbc/ffi.rkt b/collects/db/private/odbc/ffi.rkt
index 4c9e520692..5669dafd8c 100644
--- a/collects/db/private/odbc/ffi.rkt
+++ b/collects/db/private/odbc/ffi.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
-(require (rename-in racket/contract [-> c->])
-         ffi/unsafe
+(require ffi/unsafe
          ffi/unsafe/define
          "ffi-constants.rkt")
 (provide (all-from-out "ffi-constants.rkt"))
@@ -21,11 +20,6 @@
 (define _sqluinteger _uint)
 (define _sqlreturn _sqlsmallint)
 
-;; Windows ODBC defines wchar_t, thus WCHAR, as 16-bit
-;; unixodbc defines WCHAR as 16-bit for compat w/ Windows
-;; (even though Linux wchar_t is 32-bit)
-(define WCHAR-SIZE 2)
-
 (define-ffi-definer define-mz #f)
 
 (define-mz scheme_utf16_to_ucs4
@@ -119,10 +113,28 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
 (define odbc-lib
   (case (system-type)
     ((windows) (ffi-lib "odbc32.dll"))
-    (else (ffi-lib "libodbc" '("1" #f)))))
+    ((macosx)  (ffi-lib "libiodbc" '("2" #f)))
+    ((unix)    (ffi-lib "libodbc" '("1" #f)))))
+
+(define WCHAR-SIZE
+  (case (system-type)
+    ((windows)
+     ;; Windows ODBC defines wchar_t, thus WCHAR, thus SQLWCHAR, as 16-bit
+     2)
+    ((macosx)
+     ;; MacOSX uses iodbc, which defines SQLWCHAR as wchar_t, as 32-bit
+     4)
+    ((unix)
+     ;; unixodbc defines WCHAR as 16-bit for compat w/ Windows
+     ;; (even though Linux wchar_t is 32-bit)
+     2)))
 
 (define-ffi-definer define-odbc odbc-lib)
 
+(define (ok-status? n)
+  (or (= n SQL_SUCCESS)
+      (= n SQL_SUCCESS_WITH_INFO)))
+
 (define-odbc SQLAllocHandle
   (_fun (type : _sqlsmallint)
         (parent : _sqlhandle/null)
@@ -168,7 +180,8 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
                      (len : (_ptr o _sqlsmallint))
                      -> (status : _sqlreturn)
                      -> (values status
-                                (bytes->string/utf-8 value #f 0 len)))))
+                                (and (ok-status? status)
+                                     (bytes->string/utf-8 value #f 0 len))))))
 
 (define-odbc SQLGetFunctions
   (_fun (handle : _sqlhdbc)
@@ -211,7 +224,7 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
         (out-len : (_ptr o _sqlsmallint))
         -> (status : _sqlreturn)
         -> (values status
-                   (and (or (= status SQL_SUCCESS) (= status SQL_SUCCESS_WITH_INFO))
+                   (and (ok-status? status)
                         (bytes->string/utf-8 out-buf #f 0 out-len)))))
 
 (define-odbc SQLDataSources
@@ -226,9 +239,9 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
         (descr-length : (_ptr o _sqlsmallint))
         -> (status : _sqlreturn)
         -> (values status
-                   (and (or (= status SQL_SUCCESS) (= status SQL_SUCCESS_WITH_INFO))
+                   (and (ok-status? status)
                         (bytes->string/utf-8 server-buf #f 0 server-length))
-                   (and (or (= status SQL_SUCCESS) (= status SQL_SUCCESS_WITH_INFO))
+                   (and (ok-status? status)
                         (bytes->string/utf-8 descr-buf #f 0 descr-length)))))
 
 (define-odbc SQLDrivers
@@ -242,7 +255,7 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
         ((if attrs-buf (bytes-length attrs-buf) 0) : _sqlsmallint)
         (attrs-length : (_ptr o _sqlsmallint))
         -> (status : _sqlreturn)
-        -> (if (or (= status SQL_SUCCESS) (= status SQL_SUCCESS_WITH_INFO))
+        -> (if (ok-status? status)
                (values status
                        (bytes->string/utf-8 driver-buf #f 0 driver-length)
                        attrs-length)
@@ -308,7 +321,8 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
         (nullable : (_ptr o _sqlsmallint))
         -> (status : _sqlreturn)
         -> (values status
-                   (bytes->string/utf-8 column-buf #f 0 column-len)
+                   (and (ok-status? status)
+                        (bytes->string/utf-8 column-buf #f 0 column-len))
                    data-type size digits nullable)))
 
 (define-odbc SQLFetch
@@ -356,9 +370,11 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
         (message-len : (_ptr o _sqlsmallint))
         -> (status : _sqlreturn)
         -> (values status
-                   (bytes->string/utf-8 sql-state-buf #\? 0 5)
+                   (and (ok-status? status)
+                        (bytes->string/utf-8 sql-state-buf #\? 0 5))
                    native-errcode
-                   (bytes->string/utf-8 message-buf #\? 0 message-len))))
+                   (and (ok-status? status)
+                        (bytes->string/utf-8 message-buf #\? 0 message-len)))))
 
 (define-odbc SQLEndTran
   (_fun (handle completion-type) ::
diff --git a/collects/db/private/odbc/main.rkt b/collects/db/private/odbc/main.rkt
index e2e43d13f9..b5a63c6f70 100644
--- a/collects/db/private/odbc/main.rkt
+++ b/collects/db/private/odbc/main.rkt
@@ -1,53 +1,62 @@
 #lang racket/base
 (require racket/class
-         racket/contract
          "../generic/interfaces.rkt"
+         "../generic/place-client.rkt"
          "connection.rkt"
          "dbsystem.rkt"
          "ffi.rkt")
 (provide odbc-connect
          odbc-driver-connect
          odbc-data-sources
-         odbc-drivers
-         (rename-out [dbsystem odbc-dbsystem]))
+         odbc-drivers)
 
 (define (odbc-connect #:dsn dsn
                       #:user [user #f]
                       #:password [auth #f]
                       #:notice-handler [notice-handler void]
                       #:strict-parameter-types? [strict-parameter-types? #f]
-                      #:character-mode [char-mode 'wchar])
-  (let ([notice-handler (make-handler notice-handler "notice")])
-    (call-with-env 'odbc-connect
-      (lambda (env)
-        (call-with-db 'odbc-connect env
-          (lambda (db)
-            (let ([status (SQLConnect db dsn user auth)])
-              (handle-status* 'odbc-connect status db)
-              (new connection%
-                   (env env)
-                   (db db)
-                   (notice-handler notice-handler)
-                   (strict-parameter-types? strict-parameter-types?)
-                   (char-mode char-mode)))))))))
+                      #:character-mode [char-mode 'wchar]
+                      #:use-place [use-place #f])
+  (cond [use-place
+         (place-connect (list 'odbc dsn user auth strict-parameter-types? char-mode)
+                        odbc-proxy%)]
+        [else
+         (let ([notice-handler (make-handler notice-handler "notice")])
+           (call-with-env 'odbc-connect
+             (lambda (env)
+               (call-with-db 'odbc-connect env
+                 (lambda (db)
+                   (let ([status (SQLConnect db dsn user auth)])
+                     (handle-status* 'odbc-connect status db)
+                     (new connection%
+                          (env env)
+                          (db db)
+                          (notice-handler notice-handler)
+                          (strict-parameter-types? strict-parameter-types?)
+                          (char-mode char-mode))))))))]))
 
 (define (odbc-driver-connect connection-string
                              #:notice-handler [notice-handler void]
                              #:strict-parameter-types? [strict-parameter-types? #f]
-                             #:character-mode [char-mode 'wchar])
-  (let ([notice-handler (make-handler notice-handler "notice")])
-    (call-with-env 'odbc-driver-connect
-      (lambda (env)
-        (call-with-db 'odbc-driver-connect env
-          (lambda (db)
-            (let ([status (SQLDriverConnect db connection-string SQL_DRIVER_NOPROMPT)])
-              (handle-status* 'odbc-driver-connect status db)
-              (new connection%
-                   (env env)
-                   (db db)
-                   (notice-handler notice-handler)
-                   (strict-parameter-types? strict-parameter-types?)
-                   (char-mode char-mode)))))))))
+                             #:character-mode [char-mode 'wchar]
+                             #:use-place [use-place #f])
+  (cond [use-place
+         (place-connect (list 'odbc-driver connection-string strict-parameter-types? char-mode)
+                        odbc-proxy%)]
+        [else
+         (let ([notice-handler (make-handler notice-handler "notice")])
+           (call-with-env 'odbc-driver-connect
+             (lambda (env)
+               (call-with-db 'odbc-driver-connect env
+                 (lambda (db)
+                   (let ([status (SQLDriverConnect db connection-string SQL_DRIVER_NOPROMPT)])
+                     (handle-status* 'odbc-driver-connect status db)
+                     (new connection%
+                          (env env)
+                          (db db)
+                          (notice-handler notice-handler)
+                          (strict-parameter-types? strict-parameter-types?)
+                          (char-mode char-mode))))))))]))
 
 (define (odbc-data-sources)
   (define server-buf (make-bytes 1024))
@@ -97,6 +106,12 @@
         (let ([=-pos (caar m)])
           (cons (substring s 0 =-pos) (substring s (+ 1 =-pos))))))))
 
+
+(define odbc-proxy%
+  (class place-proxy-connection%
+    (super-new)
+    (define/override (get-dbsystem) dbsystem)))
+
 ;; ----
 
 ;; Aux functions to free handles on error.
diff --git a/collects/db/private/postgresql/connection.rkt b/collects/db/private/postgresql/connection.rkt
index 9f036fff11..fbd65cfa2b 100644
--- a/collects/db/private/postgresql/connection.rkt
+++ b/collects/db/private/postgresql/connection.rkt
@@ -14,6 +14,13 @@
 
 ;; ========================================
 
+;; connector<%>
+;; Manages making connections
+(define connector<%>
+  (interface ()
+    attach-to-ports              ;; input-port output-port -> void
+    start-connection-protocol))  ;; string string string/#f -> void
+
 (define connection-base%
   (class* transactions% (connection<%> connector<%>)
     (init-private notice-handler
@@ -396,6 +403,8 @@
         (set! name-counter (add1 name-counter))
         (format "λmz_~a_~a" process-id n)))
 
+    (define/public (get-base) this)
+
     ;; free-statement : prepared-statement -> void
     (define/public (free-statement pst)
       (call-with-lock* 'free-statement
diff --git a/collects/db/private/postgresql/main.rkt b/collects/db/private/postgresql/main.rkt
index 698ca42f7e..9f3311bc80 100644
--- a/collects/db/private/postgresql/main.rkt
+++ b/collects/db/private/postgresql/main.rkt
@@ -1,16 +1,13 @@
 #lang racket/base
 (require racket/class
-         racket/contract
          racket/tcp
          openssl
          "../generic/interfaces.rkt"
          "../generic/socket.rkt"
-         "connection.rkt"
-         "dbsystem.rkt")
+         "connection.rkt")
 (provide postgresql-connect
          postgresql-guess-socket-path
-         postgresql-password-hash
-         (rename-out [dbsystem postgresql-dbsystem]))
+         postgresql-password-hash)
 
 (define (postgresql-connect #:user user
                             #:database database
diff --git a/collects/db/private/sqlite3/connection.rkt b/collects/db/private/sqlite3/connection.rkt
index d2a72db847..3d9a4b5657 100644
--- a/collects/db/private/sqlite3/connection.rkt
+++ b/collects/db/private/sqlite3/connection.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/class
          ffi/unsafe
+         ffi/unsafe/atomic
          "../generic/interfaces.rkt"
          "../generic/prepared.rkt"
          "../generic/sql-data.rkt"
@@ -18,7 +19,7 @@
                   busy-retry-delay)
 
     (define -db db)
-    (define statement-table (make-weak-hasheq))
+    (define statement-table (make-hasheq))
     (define saved-tx-status #f) ;; set by with-lock, only valid while locked
 
     (inherit call-with-lock*
@@ -36,14 +37,13 @@
     (define/override (connected?) (and -db #t))
 
     (define/public (query fsym stmt)
-      (let-values ([(stmt* info rows)
+      (let-values ([(stmt* result)
                     (call-with-lock fsym
                       (lambda ()
                         (check-valid-tx-status fsym)
                         (query1 fsym stmt)))])
         (statement:after-exec stmt)
-        (cond [(pair? info) (rows-result info rows)]
-              [else (simple-result '())])))
+        result))
 
     (define/private (query1 fsym stmt)
       (let* ([stmt (cond [(string? stmt)
@@ -63,12 +63,23 @@
             (load-param fsym db stmt i param))
           (let* ([info
                   (for/list ([i (in-range (sqlite3_column_count stmt))])
-                    `((name ,(sqlite3_column_name stmt i))
-                      (decltype ,(sqlite3_column_decltype stmt i))))]
+                    `((name . ,(sqlite3_column_name stmt i))
+                      (decltype . ,(sqlite3_column_decltype stmt i))))]
                  [rows (step* fsym db stmt)])
             (HANDLE fsym (sqlite3_reset stmt))
             (HANDLE fsym (sqlite3_clear_bindings stmt))
-            (values stmt info rows)))))
+            (values stmt
+                    (cond [(pair? info)
+                           (rows-result info rows)]
+                          [else
+                           (let ([changes (sqlite3_changes db)])
+                             (cond [(and (positive? changes)
+                                         #f ;; Note: currently disabled
+                                         #| FIXME: statement was INSERT stmt |#)
+                                    (simple-result
+                                     (list (cons 'last-insert-rowid
+                                                 (sqlite3_last_insert_rowid db))))]
+                                   [else (simple-result '())]))]))))))
 
     (define/private (load-param fsym db stmt i param)
       (HANDLE fsym
@@ -149,31 +160,35 @@
           pst)))
 
     (define/public (disconnect)
-      ;; FIXME: Reorder effects to be more robust if thread killed within disconnect (?)
       (define (go)
-        (when -db
-          (let ([db -db]
-                [statements (hash-map statement-table (lambda (k v) k))])
-            (set! -db #f)
-            (set! statement-table #f)
-            (for ([pst (in-list statements)])
-              (let ([stmt (send pst get-handle)])
-                (when stmt
-                  (send pst set-handle #f)
-                  (HANDLE 'disconnect (sqlite3_finalize stmt)))))
-            (HANDLE 'disconnect (sqlite3_close db))
-            (void))))
+        (start-atomic)
+        (let ([db -db])
+          (set! -db #f)
+          (end-atomic)
+          (when db
+            (let ([statements (hash-map statement-table (lambda (k v) k))])
+              (for ([pst (in-list statements)])
+                (do-free-statement 'disconnect pst))
+              (HANDLE 'disconnect2 (sqlite3_close db))
+              (void)))))
       (call-with-lock* 'disconnect go go #f))
 
+    (define/public (get-base) this)
+
     (define/public (free-statement pst)
-      (define (go)
-        (let ([stmt (send pst get-handle)])
-          (when stmt
-            (send pst set-handle #f)
-            (HANDLE 'free-statement (sqlite3_finalize stmt))
-            (void))))
+      (define (go) (do-free-statement 'free-statement pst))
       (call-with-lock* 'free-statement go go #f))
 
+    (define/private (do-free-statement fsym pst)
+      (start-atomic)
+      (let ([stmt (send pst get-handle)])
+        (send pst set-handle #f)
+        (end-atomic)
+        (hash-remove! statement-table pst)
+        (when stmt
+          (HANDLE fsym (sqlite3_finalize stmt))
+          (void))))
+
 
     ;; == Transactions
 
@@ -198,7 +213,7 @@
                  (let ([db (get-db fsym)])
                    (when (get-tx-status db)
                      (error/already-in-tx fsym))
-                   (let-values ([(stmt* _info _rows)
+                   (let-values ([(stmt* _result)
                                  (query1 fsym "BEGIN TRANSACTION")])
                      stmt*))))])
         (statement:after-exec stmt)
@@ -212,7 +227,7 @@
                    (unless (eq? mode 'rollback)
                      (check-valid-tx-status fsym))
                    (when (get-tx-status db)
-                     (let-values ([(stmt* _info _rows)
+                     (let-values ([(stmt* _result)
                                    (case mode
                                      ((commit)
                                       (query1 fsym "COMMIT TRANSACTION"))
@@ -230,14 +245,11 @@
              ;; schema ignored, because sqlite doesn't support
              (string-append "SELECT tbl_name from sqlite_master "
                             "WHERE type = 'table' or type = 'view'")])
-        (let-values ([(stmt rows)
+        (let-values ([(stmt result)
                       (call-with-lock fsym
-                        (lambda ()
-                          (let-values ([(stmt _info rows)
-                                        (query1 fsym stmt)])
-                            (values stmt rows))))])
+                        (lambda () (query1 fsym stmt)))])
           (statement:after-exec stmt)
-          (for/list ([row (in-list rows)])
+          (for/list ([row (in-list (rows-result-rows result))])
             (vector-ref row 0)))))
 
     ;; ----
@@ -260,7 +272,7 @@
     ;; Can't figure out how to test...
     (define/private (handle-status who s)
       (when (memv s maybe-rollback-status-list)
-        (when (and saved-tx-status (not (get-tx-status -db))) ;; was in trans, now not
+        (when (and saved-tx-status -db (not (get-tx-status -db))) ;; was in trans, now not
           (set! tx-status 'invalid)))
       (handle-status* who s -db))
 
diff --git a/collects/db/private/sqlite3/dbsystem.rkt b/collects/db/private/sqlite3/dbsystem.rkt
index 12d1e2d1d6..86de61b153 100644
--- a/collects/db/private/sqlite3/dbsystem.rkt
+++ b/collects/db/private/sqlite3/dbsystem.rkt
@@ -1,8 +1,6 @@
 #lang racket/base
 (require racket/class
-         "../generic/interfaces.rkt"
-         "../generic/sql-data.rkt"
-         "ffi-constants.rkt")
+         "../generic/interfaces.rkt")
 (provide dbsystem)
 
 (define sqlite3-dbsystem%
diff --git a/collects/db/private/sqlite3/ffi.rkt b/collects/db/private/sqlite3/ffi.rkt
index a0c4d5e3ab..8fd7e8ce78 100644
--- a/collects/db/private/sqlite3/ffi.rkt
+++ b/collects/db/private/sqlite3/ffi.rkt
@@ -132,6 +132,22 @@
   (_fun _sqlite3_database
         -> _bool))
 
+(define-sqlite sqlite3_next_stmt
+  (_fun _sqlite3_database _sqlite3_statement/null
+        -> _sqlite3_statement/null))
+
+(define-sqlite sqlite3_sql
+  (_fun _sqlite3_statement
+        -> _string))
+
+(define-sqlite sqlite3_changes
+  (_fun _sqlite3_database
+        -> _int))
+
+(define-sqlite sqlite3_last_insert_rowid
+  (_fun _sqlite3_database
+        -> _int))
+
 ;; ----------------------------------------
 
 #|
diff --git a/collects/db/private/sqlite3/main.rkt b/collects/db/private/sqlite3/main.rkt
index d326c268ee..a2db4a1701 100644
--- a/collects/db/private/sqlite3/main.rkt
+++ b/collects/db/private/sqlite3/main.rkt
@@ -1,41 +1,51 @@
 #lang racket/base
 (require racket/class
-         racket/contract
          ffi/file
+         "../generic/place-client.rkt"
          "connection.rkt"
          "dbsystem.rkt"
          "ffi.rkt")
-(provide sqlite3-connect
-         (rename-out [dbsystem sqlite3-dbsystem]))
+(provide sqlite3-connect)
 
-(define (sqlite3-connect #:database path-or-sym
+(define (sqlite3-connect #:database path
                          #:mode [mode 'read/write]
                          #:busy-retry-delay [busy-retry-delay 0.1]
-                         #:busy-retry-limit [busy-retry-limit 10])
+                         #:busy-retry-limit [busy-retry-limit 10]
+                         #:use-place [use-place #f])
   (let ([path
-         (cond [(symbol? path-or-sym)
-                (case path-or-sym
-                  ;; Private, temporary in-memory
-                  [(memory) #":memory:"]
-                  ;; Private, temporary on-disk
-                  [(temporary) #""])]
-               [(or (path? path-or-sym) (string? path-or-sym))
-                (let ([path (cleanse-path (path->complete-path path-or-sym))])
-                  (security-guard-check-file 'sqlite3-connect
-                                             path
-                                             (case mode
-                                               ((read-only) '(read))
-                                               (else '(read write))))
-                  (path->bytes path))])])
-    (let-values ([(db open-status)
-                  (sqlite3_open_v2 path
-                                   (case mode
-                                     ((read-only) SQLITE_OPEN_READONLY)
-                                     ((read/write) SQLITE_OPEN_READWRITE)
-                                     ((create)
-                                      (+ SQLITE_OPEN_READWRITE SQLITE_OPEN_CREATE))))])
-      (handle-status* 'sqlite3-connect open-status db)
-      (new connection%
-           (db db)
-           (busy-retry-limit busy-retry-limit)
-           (busy-retry-delay busy-retry-delay)))))
+         (case path
+           ((memory temporary) path)
+           (else
+            (let ([path (cleanse-path (path->complete-path path))])
+              (security-guard-check-file 'sqlite3-connect
+                                         path
+                                         (case mode
+                                           ((read-only) '(read))
+                                           (else '(read write))))
+              path)))])
+    (cond [use-place
+           (place-connect (list 'sqlite3 path mode busy-retry-delay busy-retry-limit)
+                          sqlite-place-proxy%)]
+          [else
+           (let ([path-bytes
+                  (case path
+                    ((memory) #":memory:")
+                    ((temporary) #"")
+                    (else (path->bytes path)))])
+             (let-values ([(db open-status)
+                           (sqlite3_open_v2 path-bytes
+                                            (case mode
+                                              ((read-only) SQLITE_OPEN_READONLY)
+                                              ((read/write) SQLITE_OPEN_READWRITE)
+                                              ((create)
+                                               (+ SQLITE_OPEN_READWRITE SQLITE_OPEN_CREATE))))])
+               (handle-status* 'sqlite3-connect open-status db)
+               (new connection%
+                    (db db)
+                    (busy-retry-limit busy-retry-limit)
+                    (busy-retry-delay busy-retry-delay))))])))
+
+(define sqlite-place-proxy%
+  (class place-proxy-connection%
+    (super-new)
+    (define/override (get-dbsystem) dbsystem)))
diff --git a/collects/db/scribblings/config.rkt b/collects/db/scribblings/config.rkt
index d7f8479318..c3be75a1ed 100644
--- a/collects/db/scribblings/config.rkt
+++ b/collects/db/scribblings/config.rkt
@@ -1,21 +1,26 @@
 #lang racket/base
 (require scribble/manual
          scribble/eval
-         racket/sandbox
          (for-label racket/base
                     racket/contract))
 (provide (all-defined-out)
          (for-label (all-from-out racket/base)
                     (all-from-out racket/contract)))
 
+(define (tech/reference . pre-flows)
+  (apply tech #:doc '(lib "scribblings/reference/reference.scrbl") pre-flows))
+
 ;; ----
 
 (define the-eval (make-base-eval))
 (void
  (interaction-eval #:eval the-eval
                    (require racket/class
-                            db
+                            racket/pretty
+                            db/base
                             db/util/datetime))
+ (interaction-eval #:eval the-eval
+                   (current-print pretty-print-handler))
  (interaction-eval #:eval the-eval
                    (define connection% (class object% (super-new))))
  (interaction-eval #:eval the-eval
diff --git a/collects/db/scribblings/connect.scrbl b/collects/db/scribblings/connect.scrbl
index c4bbfac0fc..0b0e064bf9 100644
--- a/collects/db/scribblings/connect.scrbl
+++ b/collects/db/scribblings/connect.scrbl
@@ -16,6 +16,22 @@ administrative functions for managing connections.
 
 @declare-exporting[db]
 
+There are four kinds of base connection, and they are divided into two
+groups: @deftech{wire-based connections} and @deftech{FFI-based
+connections}. PostgreSQL and MySQL connections are wire-based, and
+SQLite and ODBC connections are FFI-based.
+
+Wire-based connections communicate using @tech/reference{ports}, which
+do not cause other Racket threads to block. In contrast, all Racket
+threads are blocked during an FFI call, so FFI-based connections can
+seriously degrade the interactivity of a Racket program, particularly
+if long-running queries are performed using the connection. This
+problem can be avoided by creating the FFI-based connection in a
+separate @tech/reference{place} using the @racket[#:use-place]
+keyword argument. Such a connection will not block all Racket threads
+during queries; the disadvantage is the cost of creating and
+communicating with a separate @tech/reference{place}.
+
 Base connections are made using the following functions.
 
 @defproc[(postgresql-connect [#:user user string?]
@@ -188,7 +204,8 @@ Base connections are made using the following functions.
                 [#:busy-retry-limit busy-retry-limit 
                  (or/c exact-nonnegative-integer? +inf.0) 10]
                 [#:busy-retry-delay busy-retry-delay
-                 (and/c rational? (not/c negative?)) 0.1])
+                 (and/c rational? (not/c negative?)) 0.1]
+                [#:use-place use-place boolean? #f])
          connection?]{
 
   Opens the SQLite database at the file named by @racket[database], if
@@ -214,6 +231,10 @@ Base connections are made using the following functions.
   attempted once. If after @racket[busy-retry-limit] retries the
   operation still does not succeed, an exception is raised.
 
+  If @racket[use-place] is true, the actual connection is created in
+  a distinct @tech/reference{place} for database connections and a
+  proxy is returned.
+
   If the connection cannot be made, an exception is raised.
 
   @(examples/results
@@ -234,7 +255,8 @@ Base connections are made using the following functions.
                        [#:strict-parameter-types? strict-parameter-types? boolean? #f]
                        [#:character-mode character-mode
                         (or/c 'wchar 'utf-8 'latin-1)
-                        'wchar])
+                        'wchar]
+                       [#:use-place use-place boolean? #f])
          connection?]{
 
   Creates a connection to the ODBC Data Source named @racket[dsn]. The
@@ -258,6 +280,10 @@ Base connections are made using the following functions.
   See @secref["odbc-status"] for notes on specific ODBC drivers and
   recommendations for connection options.
 
+  If @racket[use-place] is true, the actual connection is created in
+  a distinct @tech/reference{place} for database connections and a
+  proxy is returned.
+
   If the connection cannot be made, an exception is raised.
 }
 
@@ -269,7 +295,8 @@ Base connections are made using the following functions.
                               [#:strict-parameter-types? strict-parameter-types? boolean? #f]
                               [#:character-mode character-mode
                                (or/c 'wchar 'utf-8 'latin-1)
-                               'wchar])
+                               'wchar]
+                              [#:use-place use-place boolean? #f])
          connection?]{
 
   Creates a connection using an ODBC connection string containing a
@@ -606,7 +633,8 @@ ODBC's DSNs.
            [#:busy-retry-limit busy-retry-limit 
             (or/c exact-nonnegative-integer? +inf.0) @#,absent]
            [#:busy-retry-delay busy-retry-delay
-            (and/c rational? (not/c negative?)) @#,absent])
+            (and/c rational? (not/c negative?)) @#,absent]
+           [#:use-place use-place boolean? @#,absent])
          data-source?]
 @defproc[(odbc-data-source
            [#:dsn dsn (or/c string? #f) @#,absent]
diff --git a/collects/db/scribblings/db.scrbl b/collects/db/scribblings/db.scrbl
index 99369d1199..8b8e76d8fa 100644
--- a/collects/db/scribblings/db.scrbl
+++ b/collects/db/scribblings/db.scrbl
@@ -26,17 +26,15 @@ native client library is required.}
 
 @item{@bold{@as-index{@hyperlink["http://www.sqlite.org"]{SQLite}} version
 3.} The SQLite native client library is required; see
-@secref["sqlite3-native-libs"].}
+@secref["sqlite3-requirements"].}
 
 @item{@bold{@as-index{ODBC}.} An ODBC Driver Manager and appropriate
-ODBC drivers are required; see @secref["odbc-native-libs"]. The
-following additional database systems are known to work with this
-library's ODBC support (see @secref["odbc-status"] for details):
-@itemlist[
-@item{@bold{@as-index{@hyperlink["http://www.oracle.com"]{Oracle}}}}
-@item{@bold{@as-index{@hyperlink["http://www.ibm.com/software/data/db2/"]{DB2}}}}
-@item{@bold{@as-index{@hyperlink["http://www.microsoft.com/sqlserver/"]{SQL Server}}}}
-]}
+ODBC drivers are required; see @secref["odbc-requirements"]. The
+following database systems are known to work with this library via
+ODBC (see @secref["odbc-status"] for details):
+@bold{@as-index{@hyperlink["http://www.ibm.com/software/data/db2/"]{DB2}}},
+@bold{@as-index{@hyperlink["http://www.oracle.com"]{Oracle}}}, and
+@bold{@as-index{@hyperlink["http://www.microsoft.com/sqlserver/"]{SQL Server}}}.}
 ]
 
 The query operations are functional in spirit: queries return results
diff --git a/collects/db/scribblings/introduction.scrbl b/collects/db/scribblings/introduction.scrbl
index 7240899c1b..3ccb5e044a 100644
--- a/collects/db/scribblings/introduction.scrbl
+++ b/collects/db/scribblings/introduction.scrbl
@@ -202,15 +202,18 @@ web-server
 ]
 
 The main problem with using one connection for all requests is that
-while all connection functions are thread-safe, two threads accessing
-a connection concurrently may still interfere. For example, if two
-threads both attempt to start a new transaction, the second one will
-fail, because the first thread has already put the connection into an
-``in transaction'' state. And if one thread is accessing the
-connection within a transaction and another thread issues a query, the
-second thread may see invalid data or even disrupt the work of the
-first thread (see
-@hyperlink["http://en.wikipedia.org/wiki/Isolation_%28database_systems%29"]{isolation}).
+multiple threads accessing the same connection are not properly
+@hyperlink["http://en.wikipedia.org/wiki/Isolation_%28database_systems%29"]{isolated}. For
+example, if two threads both attempt to start a new transaction, the
+second one will fail, because the first thread has already put the
+connection into an ``in transaction'' state. And if one thread is
+accessing the connection within a transaction and another thread
+issues a query, the second thread may see invalid data or even disrupt
+the work of the first thread.
+
+A secondary problem is performance. A connection can only perform a
+single query at a time, whereas most database systems are capable of
+concurrent query processing.
 
 The proper way to use database connections in a servlet is to create a
 connection for each request and disconnect it when the request
diff --git a/collects/db/scribblings/notes.scrbl b/collects/db/scribblings/notes.scrbl
index 55d51512bd..2a5860c060 100644
--- a/collects/db/scribblings/notes.scrbl
+++ b/collects/db/scribblings/notes.scrbl
@@ -4,25 +4,27 @@
           scribble/struct
           racket/sandbox
           "config.rkt"
-          (for-label db))
+          (for-label db
+                     setup/dirs))
 
 @title[#:tag "notes"]{Notes}
 
-This section describes miscellaneous issues.
+This section discusses issues related to specific database systems.
+
 
 @section[#:tag "connecting-to-server"]{Local Sockets for PostgreSQL and MySQL Servers}
 
 PostgreSQL and MySQL servers are sometimes configured by default to
 listen only on local sockets (also called ``unix domain
 sockets''). This library provides support for communication over local
-sockets, but only on Linux (x86 and x86-64) and Mac OS X. If local
-socket communication is not available, the server must be reconfigured
-to listen on a TCP port.
+sockets on Linux (x86 and x86-64) and Mac OS X. If local socket
+communication is not available, the server must be reconfigured to
+listen on a TCP port.
 
 The socket file for a PostgreSQL server is located in the directory
 specified by the @tt{unix_socket_directory} variable in the
 @tt{postgresql.conf} server configuration file.  For example, on
-Ubuntu 10.10 running PostgreSQL 8.4, the socket directory is
+Ubuntu 11.04 running PostgreSQL 8.4, the socket directory is
 @tt{/var/run/postgresql} and the socket file is
 @tt{/var/run/postgresql/.s.PGSQL.5432}. Common socket paths may be
 searched automatically using the @racket[postgresql-guess-socket-path]
@@ -30,20 +32,19 @@ function.
 
 The socket file for a MySQL server is located at the path specified by
 the @tt{socket} variable in the @tt{my.cnf} configuration file. For
-example, on Ubuntu 10.10 running MySQL 5.1, the socket is located at
+example, on Ubuntu 11.04 running MySQL 5.1, the socket is located at
 @tt{/var/run/mysqld/mysqld.sock}. Common socket paths for MySQL can be
 searched using the @racket[mysql-guess-socket-path] function.
 
 
-@section{Database Character Encodings}
+@section{PostgreSQL Database Character Encoding}
 
-In most cases, a PostgreSQL or MySQL database's character encoding is
-irrelevant, since the connect function always requests translation to
-Unicode (UTF-8) when creating a connection. If a PostgreSQL database's
-character encoding is @tt{SQL_ASCII}, however, PostgreSQL will not
-honor the connection encoding; it will instead send untranslated
-octets, which will cause corrupt data or internal errors in the client
-connection.
+In most cases, a database's character encoding is irrelevant, since
+the connect function always requests translation to Unicode (UTF-8)
+when creating a connection. If a PostgreSQL database's character
+encoding is @tt{SQL_ASCII}, however, PostgreSQL will not honor the
+connection encoding; it will instead send untranslated octets, which
+will cause corrupt data or internal errors in the client connection.
 
 To convert a PostgreSQL database from @tt{SQL_ASCII} to something
 sensible, @tt{pg_dump} the database, recode the dump file (using a
@@ -51,31 +52,17 @@ utility such as @tt{iconv}), create a new database with the desired
 encoding, and @tt{pg_restore} from the recoded dump file.
 
 
-@section{Prepared Query Parameter Types}
-
-Different database systems vary in their handling of query parameter
-types. For example, consider the following parameterized SQL
-statement:
-
-@tt{SELECT 1 + ?;}
-
-PostgreSQL reports an expected type of @tt{integer} for the parameter and
-will not accept other types. MySQL and SQLite, in contrast, report no
-useful parameter type information, and ODBC connections vary in
-behavior based on the driver, the data source configuration, and the
-connection parameters (see @secref["odbc-status"] for specific notes).
-
-
 @section{PostgreSQL Authentication}
 
-PostgreSQL supports a large variety of authentication mechanisms,
-controlled by the @tt{pg_hba.conf} server configuration file. This
-library currently supports only cleartext and md5-hashed passwords,
-and it does not send cleartext passwords unless explicitly ordered to
-(see @racket[postgresql-connect]). These correspond to the @tt{md5}
-and @tt{password} authentication methods in the parlance of
+PostgreSQL supports a large variety of
+@hyperlink["http://www.postgresql.org/docs/8.4/static/auth-pg-hba-conf.html"]{authentication
+mechanisms}, controlled by the @tt{pg_hba.conf} server configuration
+file. This library currently supports only cleartext and md5-hashed
+passwords, and it does not send cleartext passwords unless explicitly
+ordered to (see @racket[postgresql-connect]). These correspond to the
+@tt{md5} and @tt{password} authentication methods in the parlance of
 @tt{pg_hba.conf}, respectively. On Linux, @tt{ident} authentication is
-automatically supported for unix domain sockets (but not TCP). The
+automatically supported for local sockets, but not TCP sockets. The
 @tt{gss}, @tt{sspi}, @tt{krb5}, @tt{pam}, and @tt{ldap} methods are
 not supported.
 
@@ -89,36 +76,69 @@ plugins}. The only plugin currently supported by this library is
 password authentication mechanism used since version 4.1.
 
 
-@section[#:tag "sqlite3-native-libs"]{SQLite Native Library}
+@section[#:tag "sqlite3-requirements"]{SQLite Requirements}
 
-SQLite support requires the appropriate native library, specifically
-@tt{libsqlite3.so.0} on Unix or @tt{sqlite3.dll} on Windows.
+SQLite support requires the appropriate native library.
+
+@itemlist[
+
+@item{On Windows, the library is @tt{sqlite3.dll}. It can be obtained
+from @hyperlink["http://www.sqlite.org/download.html"]{the SQLite
+download page}; the DLL file should be extracted and placed into one
+of the directories produced by
+@racketblock[(begin (require setup/dirs) (get-lib-search-dirs))]}
+
+@item{On Mac OS X, the library is @tt{libsqlite3.0.dylib}, which is
+included (in @tt{/usr/lib}) in Mac OS X version 10.4 onwards.}
+
+@item{On Linux, the library is @tt{libsqlite3.so.0}. It is included in
+the @tt{libsqlite3-0} package in Debian/Ubuntu and in the @tt{sqlite}
+package in Red Hat.}
+]
 
 
-@section[#:tag "odbc-native-libs"]{ODBC Native Libraries}
+@section[#:tag "odbc-requirements"]{ODBC Requirements}
 
-ODBC support requires the appropriate native library, specifically
-@tt{libodbc.so.1} (from unixODBC; iODBC is not supported) on Unix or
-@tt{odbc32.dll} on Windows. In addition, the appropriate ODBC Drivers
-must be installed and any Data Sources configured.
+ODBC requires the appropriate driver manager native library as well as
+driver native libraries for each database system you want use ODBC to
+connect to.
+
+@itemlist[
+
+@item{On Windows, the driver manager is @tt{odbc32.dll}, which is
+included automatically with Windows.}
+
+@item{On Mac OS X, the driver manager is @tt{libiodbc.2.dylib}
+(@hyperlink["http://www.iodbc.org"]{iODBC}), which is included (in
+@tt{/usr/lib}) in Mac OS X version 10.2 onwards.}
+
+@item{On Linux, the driver manager is @tt{libodbc.so.1}
+(@hyperlink["http://www.unixodbc.org"]{unixODBC}---iODBC is not
+supported). It is available from the @tt{unixodbc} package in
+Debian/Ubuntu and in the @tt{unixODBC} package in Red Hat.}
+]
+
+In addition, you must install the appropriate ODBC Drivers and
+configure Data Sources. Refer to the ODBC documentation for the
+specific database system for more information.
 
 
-@section[#:tag "odbc-status"]{ODBC Support Status}
+@section[#:tag "odbc-status"]{ODBC Status}
 
-ODBC support is experimental. This library is compatible only with
-ODBC 3.x Driver Managers. The behavior of ODBC connections can vary
-widely depending on the driver in use and even the configuration of a
-particular data source.
+ODBC support is experimental. The behavior of ODBC connections can
+vary widely depending on the driver in use and even the configuration
+of a particular data source.
 
 The following sections describe the configurations that this library
-has been tested with. The platform @bold{win32} means Windows Vista on
-a 32-bit processor and @bold{linux} means Ubuntu 11.04 and unixODBC on
-both x86 (32-bit) and x86-64 processors, unless otherwise
-specified. The iODBC Driver Manager is not supported.
+has been tested with.
 
 Reports of success or failure on other platforms or with other drivers
 would be appreciated.
 
+@;{
+** There's no reason to actually use the following drivers. They're just
+** useful for testing ODBC support.
+
 @subsection{PostgreSQL ODBC Driver}
 
 The PostgreSQL ODBC driver version 09.00.0300 has been tested on
@@ -149,15 +169,18 @@ Furthermore, this driver interprets the declared types of columns
 strictly, replacing nonconforming values in query results with
 @tt{NULL}. All computed columns, even those with explicit @tt{CAST}s,
 seem to be returned as @tt{text}.
+}
 
 @subsection{DB2 ODBC Driver}
 
-The driver from IBM DB2 Express-C v9.7 has been tested on @bold{linux}
+The driver from IBM DB2 Express-C v9.7 has been tested on Ubuntu 11.04
 (32-bit only).
 
 For a typical installation where the instance resides at
 @tt{/home/db2inst1}, set the following option in the Driver
-configuration: @tt{Driver = /home/db2inst1/sqllib/lib32/libdb2.so}.
+configuration: @tt{Driver =
+/home/db2inst1/sqllib/lib32/libdb2.so}. (The path would presumably be
+different for a 64-bit installation.)
 
 The DB2 driver does not seem to accept a separate argument for the
 database to connect to; it must be the same as the Data Source name.
@@ -165,7 +188,7 @@ database to connect to; it must be the same as the Data Source name.
 @subsection{Oracle ODBC Driver}
 
 The driver from Oracle Database 10g Release 2 Express Edition has been
-tested on @bold{linux} (32-bit only).
+tested on Ubuntu 11.04 (32-bit only).
 
 It seems the @tt{ORACLE_HOME} and @tt{LD_LIBRARY_PATH} environment
 variables must be set according to the @tt{oracle_env.{csh,sh}} script
@@ -185,5 +208,5 @@ Maybe Oracle bug? See:
 
 @subsection{SQL Server ODBC Driver}
 
-Basic SQL Server support has been verified on @bold{win32}, but the
-automated test suite has not yet been adapted and run.
+Basic SQL Server support has been verified on Windows (32-bit only),
+but the automated test suite has not yet been adapted and run.
diff --git a/collects/db/scribblings/query.scrbl b/collects/db/scribblings/query.scrbl
index 588d22f547..0f2d9a848c 100644
--- a/collects/db/scribblings/query.scrbl
+++ b/collects/db/scribblings/query.scrbl
@@ -68,8 +68,7 @@ way to make kill-safe connections.
 All query functions require both a connection and a
 @deftech{statement}, which is one of the following:
 @itemlist[
-@item{a string containing a single SQL statement, possibly with
-  parameters}
+@item{a string containing a single SQL statement}
 @item{a @tech{prepared statement} produced by @racket[prepare]}
 @item{a @tech{virtual statement} produced by
   @racket[virtual-statement]}
@@ -78,6 +77,29 @@ All query functions require both a connection and a
 @item{an instance of a struct type that implements @racket[prop:statement]}
 ]
 
+A SQL statement may contain parameter placeholders that stand for SQL
+scalar values. The parameter values must be supplied when the
+statement is executed; the parameterized statement and parameter
+values are sent to the database back end, which combines them
+correctly and safely.
+
+Use parameters instead of Racket string interpolation (eg,
+@racket[format] or @racket[string-append]) to avoid
+@hyperlink["http://xkcd.com/327/"]{SQL injection}, where a string
+intended to represent a SQL scalar value is interpreted as---possibly
+malicious---SQL code instead.
+
+The syntax of placeholders varies depending on the database
+system. For example:
+
+@centered{
+@tabbing{
+PostgreSQL:   @&  @tt{select * from the_numbers where n > $1;} @//
+MySQL, ODBC:  @&  @tt{select * from the_numbers where n > ?;} @//
+SQLite:       @&  supports both syntaxes (plus others)
+}
+}
+
 @defproc[(statement? [x any/c]) boolean?]{
 
   Returns @racket[#t] if @racket[x] is a @tech{statement}, @racket[#f]
@@ -118,7 +140,13 @@ The types of parameters and returned fields are described in
 
 @defproc[(query-rows [connection connection?]
                      [stmt statement?]
-                     [arg any/c] ...)
+                     [arg any/c] ...
+                     [#:group grouping-fields
+                      (or/c (vectorof string?) (listof (vectorof string?)))
+                      null]
+                     [#:group-mode group-mode
+                      (listof (or/c 'preserve-null-rows 'list))
+                      null])
          (listof vector?)]{
 
   Executes a SQL query, which must produce rows, and returns the list
@@ -130,6 +158,9 @@ The types of parameters and returned fields are described in
 [(query-rows c "select 17")
  (list (vector 17))]
 ]
+
+  If @racket[grouping-fields] is not empty, the result is the same as if
+  @racket[group-rows] had been called on the result rows.
 }
 
 @defproc[(query-list [connection connection?]
@@ -286,23 +317,56 @@ future version of this library (even new minor versions).
   supports both rows-returning and effect-only queries.
 }
 
+@defproc[(group-rows [result rows-result?]
+                     [#:group grouping-fields
+                      (or/c (vectorof string?) (listof (vectorof string?)))]
+                     [#:group-mode group-mode
+                      (listof (or/c 'preserve-null-rows 'list))
+                      null])
+         rows-result?]{
+
+If @racket[grouping-fields] is a vector, the elements must be names of
+fields in @racket[result], and @racket[result]'s rows are regrouped
+using the given fields. Each grouped row contains N+1 fields; the
+first N fields are the @racket[grouping-fields], and the final field
+is a list of ``residual rows'' over the rest of the fields. A residual
+row of all NULLs is dropped (for convenient processing of @tt{OUTER
+JOIN} results) unless @racket[group-mode] includes
+@racket['preserve-null-rows]. If @racket[group-mode] contains
+@racket['list], there must be exactly one residual field, and its
+values are included without a vector wrapper (similar to
+@racket[query-list]).
+
+@examples[#:eval the-eval
+(define vehicles-result
+  (rows-result
+   '(((name . "type")) ((name . "maker")) ((name . "model")))
+   `(#("car"  "honda"   "civic")
+     #("car"  "ford"    "focus")
+     #("car"  "ford"    "pinto")
+     #("bike" "giant"   "boulder")
+     #("bike" "schwinn" ,sql-null))))
+(group-rows vehicles-result
+            #:group '(#("type")))
+]
+
+The @racket[grouping-fields] argument may also be a list of vectors;
+in that case, the grouping process is repeated for each set of
+grouping fields. The grouping fields must be distinct.
+
+@examples[#:eval the-eval
+(group-rows vehicles-result
+            #:group '(#("type") #("maker"))
+            #:group-mode '(list))
+]
+}
+
 
 @section{Prepared Statements}
 
 A @deftech{prepared statement} is the result of a call to
 @racket[prepare].
 
-The syntax of parameterized queries varies depending on the database
-system. For example:
-
-@centered{
-@tabbing{
-PostgreSQL:   @&  @tt{select * from the_numbers where n > $1;} @//
-MySQL, ODBC:  @&  @tt{select * from the_numbers where n > ?;} @//
-SQLite:       @&  supports both syntaxes (plus others)
-}
-}
-
 Any server-side or native-library resources associated with a prepared
 statement are released when the prepared statement is
 garbage-collected or when the connection that owns it is closed;
diff --git a/collects/db/scribblings/sql-types.scrbl b/collects/db/scribblings/sql-types.scrbl
index bc2e666250..eb8066f28b 100644
--- a/collects/db/scribblings/sql-types.scrbl
+++ b/collects/db/scribblings/sql-types.scrbl
@@ -2,7 +2,7 @@
 @(require scribble/manual
           scribble/eval
           scribble/struct
-          scheme/sandbox
+          racket/sandbox
           "config.rkt"
           "tabbing.rkt"
           (for-label (prefix-in srfi: srfi/19)
@@ -57,33 +57,33 @@ along with their corresponding Racket representations.
 @centered{
 @tabbing{
   @bold{PostgreSQL type}  @& @bold{pg_type.typname}  @& @bold{Racket type} @//
-  @racket['boolean]       @& @tt{bool}               @& @scheme[boolean?] @//
-  @racket['char1]         @& @tt{char}               @& @scheme[char?] @//
-  @racket['smallint]      @& @tt{int2}               @& @scheme[exact-integer?] @//
-  @racket['integer]       @& @tt{int4}               @& @scheme[exact-integer?] @//
-  @racket['bigint]        @& @tt{int8}               @& @scheme[exact-integer?] @//
-  @racket['real]          @& @tt{float4}             @& @scheme[real?] @//
-  @racket['double]        @& @tt{float8}             @& @scheme[real?] @//
-  @racket['decimal]       @& @tt{numeric}            @& @scheme[number?] @//
-  @racket['character]     @& @tt{bpchar}             @& @scheme[string?] @//
-  @racket['varchar]       @& @tt{varchar}            @& @scheme[string?] @//
-  @racket['text]          @& @tt{text}               @& @scheme[string?] @//
-  @racket['bytea]         @& @tt{bytea}              @& @scheme[bytes?] @//
-  @racket['date]          @& @tt{date}               @& @scheme[sql-date?] @//
-  @racket['time]          @& @tt{time}               @& @scheme[sql-time?] @//
-  @racket['timetz]        @& @tt{timetz}             @& @scheme[sql-time?] @//
-  @racket['timestamp]     @& @tt{timestamp}          @& @scheme[sql-timestamp?] @//
-  @racket['timestamptz]   @& @tt{timestamptz}        @& @scheme[sql-timestamp?] @//
-  @racket['interval]      @& @tt{interval}           @& @scheme[sql-interval?] @//
-  @racket['bit]           @& @tt{bit}                @& @scheme[sql-bits?] @//
-  @racket['varbit]        @& @tt{varbit}             @& @scheme[sql-bits?] @//
+  @racket['boolean]       @& @tt{bool}               @& @racket[boolean?] @//
+  @racket['char1]         @& @tt{char}               @& @racket[char?] @//
+  @racket['smallint]      @& @tt{int2}               @& @racket[exact-integer?] @//
+  @racket['integer]       @& @tt{int4}               @& @racket[exact-integer?] @//
+  @racket['bigint]        @& @tt{int8}               @& @racket[exact-integer?] @//
+  @racket['real]          @& @tt{float4}             @& @racket[real?] @//
+  @racket['double]        @& @tt{float8}             @& @racket[real?] @//
+  @racket['decimal]       @& @tt{numeric}            @& @racket[number?] @//
+  @racket['character]     @& @tt{bpchar}             @& @racket[string?] @//
+  @racket['varchar]       @& @tt{varchar}            @& @racket[string?] @//
+  @racket['text]          @& @tt{text}               @& @racket[string?] @//
+  @racket['bytea]         @& @tt{bytea}              @& @racket[bytes?] @//
+  @racket['date]          @& @tt{date}               @& @racket[sql-date?] @//
+  @racket['time]          @& @tt{time}               @& @racket[sql-time?] @//
+  @racket['timetz]        @& @tt{timetz}             @& @racket[sql-time?] @//
+  @racket['timestamp]     @& @tt{timestamp}          @& @racket[sql-timestamp?] @//
+  @racket['timestamptz]   @& @tt{timestamptz}        @& @racket[sql-timestamp?] @//
+  @racket['interval]      @& @tt{interval}           @& @racket[sql-interval?] @//
+  @racket['bit]           @& @tt{bit}                @& @racket[sql-bits?] @//
+  @racket['varbit]        @& @tt{varbit}             @& @racket[sql-bits?] @//
 
-  @racket['point]         @& @tt{point}              @& @scheme[point?] @//
-  @racket['lseg]          @& @tt{lseg}               @& @scheme[line?] @//
-  @racket['path]          @& @tt{path}               @& @scheme[pg-path?] @//
-  @racket['box]           @& @tt{box}                @& @scheme[pg-box?] @//
-  @racket['polygon]       @& @tt{polygon}            @& @scheme[polygon?] @//
-  @racket['circle]        @& @tt{circle}             @& @scheme[pg-circle?]
+  @racket['point]         @& @tt{point}              @& @racket[point?] @//
+  @racket['lseg]          @& @tt{lseg}               @& @racket[line?] @//
+  @racket['path]          @& @tt{path}               @& @racket[pg-path?] @//
+  @racket['box]           @& @tt{box}                @& @racket[pg-box?] @//
+  @racket['polygon]       @& @tt{polygon}            @& @racket[polygon?] @//
+  @racket['circle]        @& @tt{circle}             @& @racket[pg-circle?]
 }
 }
 
@@ -92,7 +92,7 @@ syntax (the quotation marks are significant), is one byte, essentially
 a tiny integer written as a character.
 
 A SQL value of type @tt{decimal} is converted to either an exact
-rational or @scheme[+nan.0]. When converting Racket values to SQL
+rational or @racket[+nan.0]. When converting Racket values to SQL
 @tt{decimal}, exact rational values representable by finite decimal
 strings are converted without loss of precision. (Precision may be
 lost, of course, if the value is then stored in a database field of
@@ -136,19 +136,19 @@ with their corresponding Racket representations.
 @centered{
 @tabbing[#:spacing 8]{
   @bold{MySQL type}            @& @bold{Racket type} @//
-  @racket['integer]            @& @scheme[exact-integer?] @//
-  @racket['tinyint]            @& @scheme[exact-integer?] @//
-  @racket['smallint]           @& @scheme[exact-integer?] @//
-  @racket['mediumint]          @& @scheme[exact-integer?] @//
-  @racket['bigint]             @& @scheme[exact-integer?] @//
-  @racket['real]               @& @scheme[real?] @//
-  @racket['double]             @& @scheme[real?] @//
-  @racket['decimal]            @& @scheme[exact?] @//
-  @racket['varchar]            @& @scheme[string?] @//
-  @racket['var-string]         @& @scheme[string?] or @scheme[bytes?], but see below @//
-  @racket['date]               @& @scheme[sql-date?] @//
-  @racket['time]               @& @scheme[sql-time?] or @racket[sql-day-time-interval?] @//
-  @racket['datetime]           @& @scheme[sql-timestamp?] @//
+  @racket['integer]            @& @racket[exact-integer?] @//
+  @racket['tinyint]            @& @racket[exact-integer?] @//
+  @racket['smallint]           @& @racket[exact-integer?] @//
+  @racket['mediumint]          @& @racket[exact-integer?] @//
+  @racket['bigint]             @& @racket[exact-integer?] @//
+  @racket['real]               @& @racket[real?] @//
+  @racket['double]             @& @racket[real?] @//
+  @racket['decimal]            @& @racket[exact?] @//
+  @racket['varchar]            @& @racket[string?] @//
+  @racket['var-string]         @& @racket[string?] or @racket[bytes?], but see below @//
+  @racket['date]               @& @racket[sql-date?] @//
+  @racket['time]               @& @racket[sql-time?] or @racket[sql-day-time-interval?] @//
+  @racket['datetime]           @& @racket[sql-timestamp?] @//
 
   @racket['blob]               @& @racket[bytes?] @//
   @racket['tinyblob]           @& @racket[bytes?] @//
@@ -195,10 +195,10 @@ constraints (with the exception of @tt{integer primary key}) on
 @centered{
 @tabbing{
   @bold{SQLite storage class}  @& @bold{Racket type} @//
-  @tt{integer}                 @& @scheme[exact-integer?] @//
-  @tt{real}                    @& @scheme[real?] @//
-  @tt{text}                    @& @scheme[string?] @//
-  @tt{blob}                    @& @scheme[bytes?]
+  @tt{integer}                 @& @racket[exact-integer?] @//
+  @tt{real}                    @& @racket[real?] @//
+  @tt{text}                    @& @racket[string?] @//
+  @tt{blob}                    @& @racket[bytes?]
 }
 }
 
@@ -229,26 +229,26 @@ along with their corresponding Racket representations.
 @centered{
 @tabbing[#:spacing 8]{
   @bold{ODBC type}        @& @bold{Racket type} @//
-  @racket['character]     @& @scheme[string?] @//
-  @racket['varchar]       @& @scheme[string?] @//
-  @racket['longvarchar]   @& @scheme[string?] @//
-  @racket['numeric]       @& @scheme[rational?] @//
-  @racket['decimal]       @& @scheme[rational?] @//
-  @racket['integer]       @& @scheme[exact-integer?] @//
-  @racket['tinyint]       @& @scheme[exact-integer?] @//
-  @racket['smallint]      @& @scheme[exact-integer?] @//
-  @racket['bigint]        @& @scheme[exact-integer?] @//
-  @racket['float]         @& @scheme[real?] @//
-  @racket['real]          @& @scheme[real?] @//
-  @racket['double]        @& @scheme[real?] @//
-  @racket['date]          @& @scheme[sql-date?] @//
-  @racket['time]          @& @scheme[sql-time?] @//
-  @racket['datetime]      @& @scheme[sql-timestamp?] @//
-  @racket['timestamp]     @& @scheme[sql-timestamp?] @//
-  @racket['binary]        @& @scheme[bytes?] @//
-  @racket['varbinary]     @& @scheme[bytes?] @//
-  @racket['longvarbinary] @& @scheme[bytes?] @//
-  @racket['bit1]          @& @scheme[boolean?]
+  @racket['character]     @& @racket[string?] @//
+  @racket['varchar]       @& @racket[string?] @//
+  @racket['longvarchar]   @& @racket[string?] @//
+  @racket['numeric]       @& @racket[rational?] @//
+  @racket['decimal]       @& @racket[rational?] @//
+  @racket['integer]       @& @racket[exact-integer?] @//
+  @racket['tinyint]       @& @racket[exact-integer?] @//
+  @racket['smallint]      @& @racket[exact-integer?] @//
+  @racket['bigint]        @& @racket[exact-integer?] @//
+  @racket['float]         @& @racket[real?] @//
+  @racket['real]          @& @racket[real?] @//
+  @racket['double]        @& @racket[real?] @//
+  @racket['date]          @& @racket[sql-date?] @//
+  @racket['time]          @& @racket[sql-time?] @//
+  @racket['datetime]      @& @racket[sql-timestamp?] @//
+  @racket['timestamp]     @& @racket[sql-timestamp?] @//
+  @racket['binary]        @& @racket[bytes?] @//
+  @racket['varbinary]     @& @racket[bytes?] @//
+  @racket['longvarbinary] @& @racket[bytes?] @//
+  @racket['bit1]          @& @racket[boolean?]
 }
 }
 
@@ -281,13 +281,13 @@ that have no existing appropriate counterpart in Racket.
 
 @subsection{SQL NULL}
 
-SQL @tt{NULL} is translated into the unique @scheme[sql-null] value.
+SQL @tt{NULL} is translated into the unique @racket[sql-null] value.
 
 @defthing[sql-null sql-null?]{
 
   A special value used to represent @tt{NULL} values in query
-  results. The @scheme[sql-null] value may be recognized using
-  @scheme[eq?].
+  results. The @racket[sql-null] value may be recognized using
+  @racket[eq?].
 
 @(examples/results
   [(query-value c "select NULL")
@@ -362,12 +362,12 @@ values.
 
   Represents SQL times and timestamps.
 
-  The @scheme[tz] field indicates the time zone offset as the number
+  The @racket[tz] field indicates the time zone offset as the number
   of seconds east of GMT (as in SRFI 19). If @racket[tz] is
   @racket[#f], the time or timestamp does not carry time zone
   information.
 
-  The @scheme[sql-time] and @scheme[sql-timestamp] structures store
+  The @racket[sql-time] and @racket[sql-timestamp] structures store
   fractional seconds to nanosecond precision for compatibility with
   SRFI 19. Note, however, that database systems generally do not
   support nanosecond precision; PostgreSQL, for example, only supports
diff --git a/collects/db/scribblings/util.scrbl b/collects/db/scribblings/util.scrbl
index 75650bf970..ddaf4d041e 100644
--- a/collects/db/scribblings/util.scrbl
+++ b/collects/db/scribblings/util.scrbl
@@ -2,7 +2,7 @@
 @(require scribble/manual
           scribble/eval
           scribble/struct
-          scheme/sandbox
+          racket/sandbox
           "config.rkt"
           (for-label db db/util/datetime db/util/geometry db/util/postgresql))
 
diff --git a/collects/db/sqlite3.rkt b/collects/db/sqlite3.rkt
index 4641941086..26f17efc10 100644
--- a/collects/db/sqlite3.rkt
+++ b/collects/db/sqlite3.rkt
@@ -9,5 +9,6 @@
   (->* (#:database (or/c path-string? 'memory 'temporary))
        (#:mode (or/c 'read-only 'read/write 'create)
         #:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
-        #:busy-retry-delay (and/c rational? (not/c negative?)))
-       any/c)])
+        #:busy-retry-delay (and/c rational? (not/c negative?))
+        #:use-place any/c)
+       connection?)])
diff --git a/collects/db/util/private/geometry.rkt b/collects/db/util/private/geometry.rkt
index c674fbb3aa..07617a7961 100644
--- a/collects/db/util/private/geometry.rkt
+++ b/collects/db/util/private/geometry.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
-(require racket/contract
-         racket/list)
+(require racket/list)
 (provide (all-defined-out))
 
 #|
diff --git a/collects/deinprogramm/signature/module-begin.rkt b/collects/deinprogramm/signature/module-begin.rkt
index 20c05553f8..ddcba39e81 100644
--- a/collects/deinprogramm/signature/module-begin.rkt
+++ b/collects/deinprogramm/signature/module-begin.rkt
@@ -174,7 +174,7 @@
 		 ;; Lift out certain forms to make them visible to the module
 		 ;;  expander:
 		 (syntax-case e2 (#%require #%provide
-				  define-syntaxes define-values-for-syntax define-values begin
+				  define-syntaxes begin-for-syntax define-values begin
 				  define-record-procedures define-record-procedures-2
 				  define-record-procedures-parametric define-record-procedures-parametric-2
 				  define-contract :)
@@ -184,7 +184,7 @@
 		    #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
 		   ((define-syntaxes (id ...) . _)
 		    #`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids))))
-		   ((define-values-for-syntax . _)
+		   ((begin-for-syntax . _)
 		    #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
 		   ((begin b1 ...)
 		    (syntax-track-origin 
diff --git a/collects/drracket/private/auto-language.rkt b/collects/drracket/private/auto-language.rkt
index 35088ef977..44ec5a5d5e 100644
--- a/collects/drracket/private/auto-language.rkt
+++ b/collects/drracket/private/auto-language.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/framework/framework 
 	 typed/mred/mred
@@ -6,9 +6,6 @@
 
 (provide pick-new-language looks-like-module?)
 
-(: reader-tag String)
-(define reader-tag "#reader")
-
 (define-type-alias (Language:Language% Settings)
   (Class () () ([get-reader-module (-> Sexp)]
                 [get-metadata-lines (-> Number)]
diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt
index 40cc97f4a9..4e8728c243 100644
--- a/collects/drracket/private/debug.rkt
+++ b/collects/drracket/private/debug.rkt
@@ -900,7 +900,8 @@ profile todo:
               (message-box (string-constant drscheme)
                            (string-constant editor-changed-since-srcloc-recorded)
                            frame
-                           '(ok caution))))
+                           '(ok caution)
+                           #:dialog-mixin frame:focus-table-mixin)))
           (when (and rep editor)
             (when (is-a? editor text:basic<%>)
               (send rep highlight-errors same-src-srclocs '())
@@ -1007,7 +1008,8 @@ profile todo:
                     (string-constant test-coverage-clear-and-do-not-ask-again)
                     (send (get-canvas) get-top-level-window)
                     '(default=1)
-                    2)])
+                    2
+                    #:dialog-mixin frame:focus-table-mixin)])
               (case msg-box-result
                 [(1) #t]
                 [(2) #f]
@@ -1419,7 +1421,8 @@ profile todo:
                     (eq? (message-box (string-constant drscheme)
                                       (string-constant profiling-clear?)
                                       frame
-                                      '(yes-no))
+                                      '(yes-no)
+                                      #:dialog-mixin frame:focus-table-mixin)
                          'yes))))))
       
       (define/private (do-reset-profile)
@@ -1561,7 +1564,8 @@ profile todo:
            (send (get-current-tab) refresh-profile)]
           [else
            (message-box (string-constant drscheme)
-                        (string-constant profiling-no-information-available))]))
+                        (string-constant profiling-no-information-available)
+                        #:dialog-mixin frame:focus-table-mixin)]))
       
       (define/public (hide-profile-gui)
         (when profile-gui-constructed?
diff --git a/collects/drracket/private/expanding-place.rkt b/collects/drracket/private/expanding-place.rkt
index 1cc8fbd59d..d4b302a417 100644
--- a/collects/drracket/private/expanding-place.rkt
+++ b/collects/drracket/private/expanding-place.rkt
@@ -17,7 +17,8 @@
   ;; get the module-language-compile-lock in the initial message
   (set! module-language-parallel-lock-client
         (compile-lock->parallel-lock-client
-         (place-channel-get p)))
+         (place-channel-get p)
+         (current-custodian)))
   
   ;; get the handlers in a second message
   (set! handlers (for/list ([lst (place-channel-get p)])
@@ -43,6 +44,7 @@
 
 (define (abort-job job)
   (custodian-shutdown-all (job-cust job))
+  (log-info "expanding-place.rkt: kill")
   (place-channel-put (job-response-pc job) #f))
 
 (struct exn:access exn:fail ())
diff --git a/collects/drracket/private/frame.rkt b/collects/drracket/private/frame.rkt
index a13e60daa7..590e225b4d 100644
--- a/collects/drracket/private/frame.rkt
+++ b/collects/drracket/private/frame.rkt
@@ -295,7 +295,8 @@
                              [else
                               (message-box (string-constant drscheme)
                                            (format (string-constant keybindings-planet-malformed-spec)
-                                                   planet-spec))]))))))
+                                                   planet-spec)
+                                           #:dialog-mixin frame:focus-table-mixin)]))))))
                (let ([ud (preferences:get 'drracket:user-defined-keybindings)])
                  (unless (null? ud)
                    (new separator-menu-item% (parent keybindings-menu))
@@ -343,7 +344,8 @@
                                                  (if (path? item)
                                                      (path->string item)
                                                      (format "~s" item))
-                                                 (exn-message x)))
+                                                 (exn-message x))
+                                         #:dialog-mixin frame:focus-table-mixin)
                             #f)])
       (keymap:add-user-keybindings-file item)
       #t))
@@ -459,7 +461,8 @@
                        (message-box (string-constant drscheme)
                                     (if (exn? exn)
                                         (format "~a" (exn-message exn))
-                                        (format "~s" exn))))])
+                                        (format "~s" exn))
+                                    #:dialog-mixin frame:focus-table-mixin))])
       (let* ([url (string->url s-url)]
              [tmp-filename (make-temporary-file "tmp~a.plt")]
              [port (get-impure-port url)]
diff --git a/collects/drracket/private/init.rkt b/collects/drracket/private/init.rkt
index eb331b133f..8bee64b9ab 100644
--- a/collects/drracket/private/init.rkt
+++ b/collects/drracket/private/init.rkt
@@ -1,7 +1,8 @@
 #lang racket/unit
   (require string-constants
            "drsig.rkt"
-           racket/gui/base)
+           racket/gui/base
+           framework)
   
   
   (import)
@@ -50,4 +51,4 @@
          
          (parameterize ([current-custodian system-custodian])
            (parameterize ([current-eventspace error-display-eventspace])
-             (message-box title text #f '(stop ok))))))))
+             (message-box title text #f '(stop ok) #:dialog-mixin frame:focus-table-mixin)))))))
diff --git a/collects/drracket/private/language-configuration.rkt b/collects/drracket/private/language-configuration.rkt
index 1370d7259f..67a6a00177 100644
--- a/collects/drracket/private/language-configuration.rkt
+++ b/collects/drracket/private/language-configuration.rkt
@@ -162,7 +162,7 @@
     (define language-dialog
       (λ (show-welcome? language-settings-to-show [parent #f])
         (define ret-dialog%
-          (class dialog%
+          (class (frame:focus-table-mixin dialog%)
             (define/override (on-subwindow-char receiver evt)
               (case (send evt get-key-code)
                 [(escape) (cancel-callback)]
@@ -170,7 +170,7 @@
                 [else
                  (or (key-pressed receiver evt)
                      (super on-subwindow-char receiver evt))]))
-            (super-instantiate ())))
+            (super-new)))
         
         (define dialog (instantiate ret-dialog% ()
                          (label (if show-welcome?
@@ -214,7 +214,8 @@
         (define (ok-callback)
           (unless (enter-callback)
             (message-box (string-constant drscheme)
-                         (string-constant please-select-a-language))))
+                         (string-constant please-select-a-language)
+                         #:dialog-mixin frame:focus-table-mixin)))
         
         ;; cancel-callback : -> void
         (define (cancel-callback)
@@ -1285,7 +1286,8 @@
                                                 (message-box (string-constant drscheme)
                                                              (if (exn? x)
                                                                  (exn-message x)
-                                                                 (format "uncaught exception: ~s" x)))
+                                                                 (format "uncaught exception: ~s" x))
+                                                             #:dialog-mixin frame:focus-table-mixin)
                                                 read-syntax/namespace-introduce)])
                                (contract
                                 (->* ()
@@ -1335,7 +1337,8 @@
                  numberss
                  summaries
                  urls
-                 reader-specs))])))))
+                 reader-specs)
+                #:dialog-mixin frame:focus-table-mixin)])))))
     
     (define (platform-independent-string->path str)
       (apply
diff --git a/collects/drracket/private/language.rkt b/collects/drracket/private/language.rkt
index ccf7aedb4b..b662354dcd 100644
--- a/collects/drracket/private/language.rkt
+++ b/collects/drracket/private/language.rkt
@@ -783,7 +783,8 @@
             [(string=? "" filename-str)
              (message-box (string-constant drscheme)
                           (string-constant please-specify-a-filename)
-                          dlg)
+                          dlg
+                          #:dialog-mixin frame:focus-table-mixin)
              #f]
             [(not (users-name-ok? mode extension dlg (string->path filename-str)))
              #f]
@@ -797,7 +798,8 @@
       (eq? (message-box (string-constant drscheme)
                         (format (string-constant are-you-sure-delete?) filename)
                         dlg
-                        '(yes-no))
+                        '(yes-no)
+                        #:dialog-mixin frame:focus-table-mixin)
            'yes))
     
     (define cancelled? #t)
@@ -904,7 +906,8 @@
                                [(distribution) (string-constant distribution)])
                              name
                              extension)
-                            parent)
+                            parent
+                            #:dialog-mixin frame:focus-table-mixin)
                #f)))))
   
   ;; default-executable-filename : path symbol boolean -> path
@@ -940,7 +943,8 @@
                      (λ (x)
                        (message-box 
                         (string-constant drscheme)
-                        (format "~a" (exn-message x)))
+                        (format "~a" (exn-message x))
+                        #:dialog-mixin frame:focus-table-mixin)
                        (void))])
       (define init-code-tmp-filename (make-temporary-file "drs-standalone-exectable-init~a"))
       (define bootstrap-tmp-filename (make-temporary-file "drs-standalone-exectable-bootstrap~a"))
@@ -1163,7 +1167,8 @@
                      (λ (x)
                        (message-box 
                         (string-constant drscheme)
-                        (format "~a" (exn-message x)))
+                        (format "~a" (exn-message x))
+                        #:dialog-mixin frame:focus-table-mixin)
                        (void))])
       
       ((if gui? make-mred-launcher make-mzscheme-launcher)
diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt
index 6270a460a4..ec0dacb7a2 100644
--- a/collects/drracket/private/main.rkt
+++ b/collects/drracket/private/main.rkt
@@ -116,7 +116,7 @@
                                  ll))))
 
 (drr:set-default 'drracket:module-language-first-line-special? #t boolean?)
-
+(drr:set-default 'drracket:use-old-style-keybindings #f boolean?)
 (drr:set-default 'drracket:defns-popup-sort-by-name? #f boolean?)
 (drr:set-default 'drracket:show-line-numbers? #f boolean?)
 
@@ -329,6 +329,10 @@
 
      (make-check-box 'drracket:module-language-first-line-special?
                      (string-constant ml-always-show-#lang-line)
+                     editor-panel)
+     
+     (make-check-box 'drracket:use-old-style-keybindings
+                     (string-constant old-style-keybindings)
                      editor-panel)))
   
   (preferences:add-to-editor-checkbox-panel
diff --git a/collects/drracket/private/module-language-tools.rkt b/collects/drracket/private/module-language-tools.rkt
index 14c7c42b66..c0751f00e8 100644
--- a/collects/drracket/private/module-language-tools.rkt
+++ b/collects/drracket/private/module-language-tools.rkt
@@ -89,7 +89,7 @@
   
   (define definitions-text-mixin
     (mixin (text:basic<%> drracket:unit:definitions-text<%>) (drracket:module-language-tools:definitions-text<%>)
-      (inherit get-next-settings)
+      (inherit get-next-settings get-filename)
       (define in-module-language? #f)      ;; true when we are in the module language
       (define hash-lang-last-location #f)  ;; non-false when we know where the hash-lang line ended
       (define hash-lang-language #f)       ;; non-false is the string that was parsed for the language
@@ -101,13 +101,26 @@
         (inner (void) after-delete start len)
         (modification-at start))
       
+      (define last-filename #f)
+      (define/augment (after-save-file success?)
+        (inner (void) after-save-file success?)
+        (define this-filename (get-filename))
+        (unless (equal? last-filename this-filename)
+          (set! last-filename this-filename)
+          (modification-at #f)))
+      
       (define timer #f)
       
+      ;; modification-at : (or/c #f number) -> void
+      ;; checks to see if the lang line has changed when start
+      ;; is in the region of the lang line, or when start is #f, or
+      ;; when there is no #lang line known.
       (define/private (modification-at start)
         (send (send (get-tab) get-frame) when-initialized
               (λ ()
                 (when in-module-language?
-                  (when (or (not hash-lang-last-location)
+                  (when (or (not start)
+                            (not hash-lang-last-location)
                             (<= start hash-lang-last-location))
                     
                     (unless timer
diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt
index dc041a3df6..54d8863071 100644
--- a/collects/drracket/private/module-language.rkt
+++ b/collects/drracket/private/module-language.rkt
@@ -9,7 +9,7 @@
          racket/sandbox
          racket/runtime-path
          racket/math
-         mred
+         racket/gui/base
          compiler/embed
          compiler/cm
          launcher
@@ -18,6 +18,7 @@
          planet/config
          setup/dirs
          racket/place
+         "tooltip.rkt"
          "drsig.rkt"
          "rep.rkt"
          "eval-helpers.rkt"
@@ -532,7 +533,9 @@
        new-parent
        #:case-sensitive #t
        
-       #:get-debugging-radio-box (λ (rb-l rb-r) (set! left-debugging-radio-box rb-l) (set! right-debugging-radio-box rb-r))
+       #:get-debugging-radio-box (λ (rb-l rb-r) 
+                                   (set! left-debugging-radio-box rb-l)
+                                   (set! right-debugging-radio-box rb-r))
        
        #:debugging-radio-box-callback
        (λ (debugging-radio-box evt)
@@ -658,7 +661,8 @@
     
     (define (get-lb-vector)
       (list->vector (for/list ([n (in-range (send collection-paths-lb get-number))])
-                              (cons (send collection-paths-lb get-string n) (send collection-paths-lb get-data n)))))
+                              (cons (send collection-paths-lb get-string n)
+                                    (send collection-paths-lb get-data n)))))
     
     (define (set-lb-vector vec)
       (send collection-paths-lb clear)
@@ -829,7 +833,9 @@
                    [stretchable-height #f]
                    [parent expand-error-parent-panel]))
         
-        (set! expand-error-message (new error-message% [parent expand-error-panel] [stretchable-width #t] [msg "hi"]))
+        (set! expand-error-message (new error-message% [parent expand-error-panel]
+                                        [stretchable-width #t]
+                                        [msg "hi"]))
         (set! expand-error-button-parent-panel
               (new vertical-panel% 
                    [stretchable-width #f]
@@ -909,24 +915,11 @@
         (cond
           [tooltip-labels
            (unless tooltip-frame
-             (set! tooltip-frame 
-                   (new (class frame%
-                          (define/override (on-subwindow-event r evt)
-                            (cond
-                              [(send evt button-down?)
-                               (hide-tooltip)
-                               #t]
-                              [else #f]))
-                          (super-new [style '(no-resize-border no-caption float)]
-                                     [label ""]
-                                     [stretchable-width #f]
-                                     [stretchable-height #f] ))))
-             (new yellow-message% [parent tooltip-frame]))
-           (send (car (send tooltip-frame get-children)) set-lab tooltip-labels)
-           (send tooltip-frame reflow-container)
+             (set! tooltip-frame (new tooltip-frame%)))
+           (send tooltip-frame set-tooltip tooltip-labels)
            (define-values (rx ry) (send running-canvas client->screen 0 0))
-           (send tooltip-frame move (- rx (send tooltip-frame get-width)) (- ry (send tooltip-frame get-height)))
-           (send tooltip-frame show #t)]
+           (define-values (cw ch) (send running-canvas get-client-size))
+           (send tooltip-frame show-over rx ry cw ch #:prefer-upper-left? #t)]
           [else
            (when tooltip-frame
              (send tooltip-frame show #f))]))
@@ -1098,10 +1091,11 @@
       (unless place-initialized?
         (set! place-initialized? #t)
         (place-channel-put expanding-place module-language-compile-lock)
-        (place-channel-put expanding-place 
-                           (for/list ([o-e-h (in-list (drracket:module-language-tools:get-online-expansion-handlers))])
-                             (list (drracket:module-language-tools:online-expansion-handler-mod-path o-e-h)
-                                   (drracket:module-language-tools:online-expansion-handler-id o-e-h)))))
+        (place-channel-put
+         expanding-place 
+         (for/list ([o-e-h (in-list (drracket:module-language-tools:get-online-expansion-handlers))])
+           (list (drracket:module-language-tools:online-expansion-handler-mod-path o-e-h)
+                 (drracket:module-language-tools:online-expansion-handler-id o-e-h)))))
       (set! pending-thread
             (thread (λ () 
                       (define-values (pc-in pc-out) (place-channel))
@@ -1131,7 +1125,7 @@
             drracket:unit:definitions-text<%>
             drracket:module-language-tools:definitions-text<%>) ()
       (inherit last-position find-first-snip get-top-level-window get-filename
-               get-tab highlight-range get-canvas 
+               get-tab get-canvas invalidate-bitmap-cache 
                set-position get-start-position get-end-position)
       
       (define compilation-out-of-date? #f)
@@ -1145,7 +1139,6 @@
       
       (define/private (buffer-modified)
         (clear-old-error)
-        (set! clear-old-error void)
         (reset-frame-expand-error)
         (let ([tlw (get-top-level-window)])
           (when expanding-place
@@ -1178,7 +1171,6 @@
                              (λ (res) (show-results res)))
               (when status-line-open?
                 (clear-old-error)
-                (set! clear-old-error void)
                 (reset-frame-expand-error))
               (send (get-tab) show-bkg-running 'running sc-online-expansion-running)))))
       
@@ -1203,7 +1195,6 @@
           (values str fn)))
       
       (define status-line-open? #f)
-      (define clear-old-error void) 
       
       (define error-message-str #f)
       (define error-message-srclocs '())
@@ -1255,40 +1246,35 @@
           [(exn)
            (define tlw (send (get-tab) get-frame))
            (send (get-tab) show-bkg-running 'nothing #f)
-           (clear-old-error)
            (set! error-message-str (vector-ref res 1))
            (set! error-message-srclocs (vector-ref res 2))
-           (set! clear-old-error
-                 (for/fold ([clear void])
-                           ([range (in-list (vector-ref res 2))])
+           (set! error-ranges 
+                 (for/list ([range (in-list (vector-ref res 2))])
                    (define pos (vector-ref range 0))
                    (define span (vector-ref range 1))
-                   (define clear-next (highlight-range (- pos 1) (+ pos span -1) "Gold" #f 'high))
-                   (lambda () (clear) (clear-next))))
+                   (list (- pos 1) (+ pos span -1))))
+           ;; should really only invalidate the appropriate region here (and in clear-error-ranges)
+           (invalidate-bitmap-cache 0 0 'display-end 'display-end)
            (update-frame-expand-error)]
           [(access-violation)
            (send (get-tab) show-bkg-running 'failed (gui-utils:format-literal-label "~a" (vector-ref res 1)))
            (clear-old-error)
-           (set! clear-old-error void)
            (reset-frame-expand-error)]
           [(reader-in-defs-error)
-           (send (get-tab) show-bkg-running 'reader-in-defs-error (gui-utils:format-literal-label "~a" (vector-ref res 1)))
+           (send (get-tab) show-bkg-running 'reader-in-defs-error
+                 (gui-utils:format-literal-label "~a" (vector-ref res 1)))
            (clear-old-error)
-           (set! clear-old-error void)
            (reset-frame-expand-error)]
           [(abnormal-termination)
            (send (get-tab) show-bkg-running 'failed sc-abnormal-termination)
            (clear-old-error)
-           (set! clear-old-error void)
            (reset-frame-expand-error)]
           [(no-errors)
            (send (get-tab) show-bkg-running 'nothing #f)
            (clear-old-error)
-           (set! clear-old-error void)
            (reset-frame-expand-error)]
           [(handler-results)
            (clear-old-error)
-           (set! clear-old-error void)
            (reset-frame-expand-error)
            ;; inform the installed handlers that something has come back
            (for ([key-val (in-list (vector-ref res 1))])
@@ -1303,6 +1289,68 @@
           [else
            (error 'module-language.rkt "unknown response from the expanding place: ~s\n" res)]))
       
+      
+      (define error-ranges '())
+      (define/private (clear-old-error)
+        (set! error-ranges '())
+        (invalidate-bitmap-cache 0 0 'display-end 'display-end))
+      
+      (define byt (box 0.0))
+      (define byb (box 0.0))
+      (define vbx (box 0.0))
+      (define vby (box 0.0))
+      (define vbw (box 0.0))
+      (define vbh (box 0.0))
+    
+      (inherit position-location get-admin)
+      (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
+        (super on-paint before? dc left top right bottom dx dy draw-caret)
+        (unless before?
+          (define pen-width 8)
+          (define saved-brush (send dc get-brush))
+          (define saved-pen (send dc get-pen))
+          (define smoothing (send dc get-smoothing))
+          (send dc set-smoothing 'smoothed)
+          
+          (define path (new dc-path%))
+          (send dc set-brush "black" 'transparent)
+          (send dc set-pen (send the-pen-list find-or-create-pen "red" pen-width 'solid 'butt 'miter))
+          (send dc set-alpha .4)
+          
+          (for ([error-range (in-list error-ranges)])
+            (define start-pos (list-ref error-range 0))
+            (define end-pos (list-ref error-range 1))
+            (position-location start-pos #f byt)
+            (position-location end-pos #f byb #f)
+            (send (get-admin) get-view vbx vby vbw vbh)
+            
+            (define x2 (+ dx (unbox vbx) (unbox vbw) (- (/ pen-width 2)) (- (/ pen-width 1))))
+            (define y2 (+ dy (unbox byt)))
+            
+            (define x1 (+ x2 (- (/ pen-width 1))))
+            (define y1 y2)
+            
+            (define x3 x2)
+            (define y3 (+ dy (unbox byb)))
+            
+            (define x4 x1)
+            (define y4 y3)
+            
+            (send path move-to x1 y1)
+            (send path line-to x2 y2)
+            (send path line-to x3 y3)
+            (send path line-to x4 y4)
+            (send path line-to x3 y3)
+            (send path line-to x2 y2)
+            (send path move-to x1 y1)
+            (send path close))
+          
+          (send dc draw-path path)
+          (send dc set-alpha 1)
+          (send dc set-brush saved-brush)
+          (send dc set-pen saved-pen)
+          (send dc set-smoothing smoothing)))
+      
       (define/override (move-to-new-language)
         ;; this is here to get things running for the initital tab in a new frame
         (super move-to-new-language)
@@ -1396,7 +1444,8 @@
   
   (define module-language-parallel-lock-client
     (compile-lock->parallel-lock-client
-     module-language-compile-lock))
+     module-language-compile-lock
+     (current-custodian)))
 
   ;; in-module-language : top-level-window<%> -> module-language-settings or #f
   (define (in-module-language tlw)
diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt
index bd41e6afd1..975a0e6b2c 100644
--- a/collects/drracket/private/rep.rkt
+++ b/collects/drracket/private/rep.rkt
@@ -903,7 +903,7 @@ TODO
                                   (floor (/ new-limit 1024 1024))))
                      frame
                      '(default=1 stop)
-                     )])
+                     #:dialog-mixin frame:focus-table-mixin)])
           (when (equal? ans 3)
             (set-custodian-limit new-limit)
             (preferences:set 'drracket:child-only-memory-limit new-limit))
@@ -1369,7 +1369,8 @@ TODO
                          #f
                          (or (get-top-level-window) (get-can-close-parent))
                          '(default=1 caution)
-                         2)
+                         2
+                         #:dialog-mixin frame:focus-table-mixin)
                         1)]
                [(let ([user-eventspace (get-user-eventspace)])
                   (and user-eventspace
@@ -1383,7 +1384,8 @@ TODO
                          #f
                          (or (get-top-level-window) (get-can-close-parent))
                          '(default=1 caution)
-                         2)
+                         2
+                         #:dialog-mixin frame:focus-table-mixin)
                         1)]
                [else #t])
              (inner #t can-close?)))
diff --git a/collects/drracket/private/syncheck/contract-traversal.rkt b/collects/drracket/private/syncheck/contract-traversal.rkt
index 4c7e473826..095c90c71d 100644
--- a/collects/drracket/private/syncheck/contract-traversal.rkt
+++ b/collects/drracket/private/syncheck/contract-traversal.rkt
@@ -109,7 +109,7 @@
             (call-give-up)]
            [(define-syntaxes (id ...) expr)
             (call-give-up)]
-           [(define-values-for-syntax (id ...) expr)
+           [(begin-for-syntax (id ...) expr)
             (call-give-up)]
            [(#%require rspec ...)
             (call-give-up)]
diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt
index 8555ecf944..713156a3a1 100644
--- a/collects/drracket/private/syncheck/gui.rkt
+++ b/collects/drracket/private/syncheck/gui.rkt
@@ -50,7 +50,8 @@ If the namespace does not, they are colored the unbound color.
          "intf.rkt"
          "colors.rkt"
          "traversals.rkt"
-         "annotate.rkt")
+         "annotate.rkt"
+         "../tooltip.rkt")
 (provide tool@)
 
 (define orig-output-port (current-output-port))
@@ -198,6 +199,8 @@ If the namespace does not, they are colored the unbound color.
       #:transparent)
     (define-struct (tail-arrow arrow) (from-text from-pos to-text to-pos) #:transparent)
     
+    (define-struct tooltip-info (text pos-left pos-right msg) #:transparent)
+    
     ;; color : string
     ;; text: text:basic<%>
     ;; start, fin: number
@@ -470,10 +473,7 @@ If the namespace does not, they are colored the unbound color.
               (set! arrow-records (make-hasheq))
               (set! bindings-table (make-hash))
               (set! cleanup-texts '())
-              (set! style-mapping (make-hash))
-              (let ([f (get-top-level-window)])
-                (when f
-                  (send f open-status-line 'drracket:check-syntax:mouse-over))))
+              (set! style-mapping (make-hash)))
             
             (define/public (syncheck:arrows-visible?)
               (or arrow-records cursor-location cursor-text))
@@ -493,9 +493,7 @@ If the namespace does not, they are colored the unbound color.
                 (set! style-mapping #f)
                 (invalidate-bitmap-cache)
                 (update-docs-background #f)
-                (let ([f (get-top-level-window)])
-                  (when f
-                    (send f close-status-line 'drracket:check-syntax:mouse-over)))))
+                (clear-tooltips)))
             
             ;; syncheck:apply-style/remember : (is-a?/c text%) number number style% symbol -> void
             (define/public (syncheck:apply-style/remember txt start finish style mode)
@@ -538,14 +536,13 @@ If the namespace does not, they are colored the unbound color.
                 [else #f]))
             
             (define/public (syncheck:add-require-open-menu text start-pos end-pos file)
-              (define (make-require-open-menu file)
-                (λ (menu)
-                  (let-values ([(base name dir?) (split-path file)])
-                    (instantiate menu-item% ()
-                      (label (fw:gui-utils:format-literal-label (string-constant cs-open-file) (path->string name)))
-                      (parent menu)
-                      (callback (λ (x y) (fw:handler:edit-file file))))
-                    (void))))
+              (define ((make-require-open-menu file) menu)
+                (define-values (base name dir?) (split-path file))
+                (new menu-item%
+                     (label (fw:gui-utils:format-literal-label (string-constant cs-open-file) (path->string name)))
+                     (parent menu)
+                     (callback (λ (x y) (fw:handler:edit-file file))))
+                (void))
               (syncheck:add-menu text start-pos end-pos #f (make-require-open-menu file)))
             
             (define/public (syncheck:add-docs-menu text start-pos end-pos id the-label path tag)
@@ -573,14 +570,14 @@ If the namespace does not, they are colored the unbound color.
             (define/public (syncheck:add-rename-menu id-as-sym to-be-renamed/poss name-dup?)
               (define (make-menu menu)
                 (let ([name-to-offer (format "~a" id-as-sym)])
-                  (instantiate menu-item% ()
-                    (parent menu)
-                    (label (fw:gui-utils:format-literal-label (string-constant cs-rename-var) name-to-offer))
-                    (callback
-                     (λ (x y)
-                       (let ([frame-parent (find-menu-parent menu)])
-                         (rename-callback name-to-offer
-                                          frame-parent)))))))
+                  (new menu-item%
+                       [parent menu]
+                       [label (fw:gui-utils:format-literal-label (string-constant cs-rename-var) name-to-offer)]
+                       [callback
+                        (λ (x y)
+                          (let ([frame-parent (find-menu-parent menu)])
+                            (rename-callback name-to-offer
+                                             frame-parent)))])))
               
               ;; rename-callback : string 
               ;;                   (and/c syncheck-text<%> definitions-text<%>)
@@ -597,7 +594,8 @@ If the namespace does not, they are colored the unbound color.
                            (string-constant cs-rename-id)
                            (fw:gui-utils:format-literal-label (string-constant cs-rename-var-to) name-to-offer)
                            parent
-                           name-to-offer)))])
+                           name-to-offer
+                           #:dialog-mixin frame:focus-table-mixin)))])
                   (when new-str
                     (define new-sym (format "~s" (string->symbol new-str)))
                     (define dup-name? (name-dup? new-sym))
@@ -613,7 +611,8 @@ If the namespace does not, they are colored the unbound color.
                             (string-constant cancel)
                             #f
                             parent
-                            '(stop default=2))
+                            '(stop default=2)
+                            #:dialog-mixin frame:focus-table-mixin)
                            1)))
                     
                     (when do-renaming?
@@ -666,7 +665,7 @@ If the namespace does not, they are colored the unbound color.
               
             (define/private (syncheck:add-menu text start-pos end-pos key make-menu)
               (when arrow-records
-                (when (and (<= 0 start-pos end-pos (last-position)))
+                (when (<= 0 start-pos end-pos (last-position))
                   (add-to-range/key text start-pos end-pos make-menu key (and key #t)))))
             
             (define/public (syncheck:add-background-color text start fin color)
@@ -704,9 +703,10 @@ If the namespace does not, they are colored the unbound color.
             
             ;; syncheck:add-mouse-over-status : text pos-left pos-right string -> void
             (define/public (syncheck:add-mouse-over-status text pos-left pos-right str)
-              (let ([str (gui-utils:format-literal-label "~a" str)])
-                (when arrow-records
-                  (add-to-range/key text pos-left pos-right str #f #f))))
+              (when arrow-records
+                (add-to-range/key text pos-left pos-right 
+                                  (make-tooltip-info text pos-left pos-right str)
+                                  #f #f)))
             
             ;; add-to-range/key : text number number any any boolean -> void
             ;; adds `key' to the range `start' - `end' in the editor
@@ -880,7 +880,6 @@ If the namespace does not, they are colored the unbound color.
             (define last-known-mouse-x #f)
             (define last-known-mouse-y #f)
             (define/override (on-event event)
-              
               (cond
                 [(send event leaving?)
                  (set! last-known-mouse-x #f)
@@ -897,9 +896,6 @@ If the namespace does not, they are colored the unbound color.
                        (set! cursor-location #f)
                        (set! cursor-text #f)
                        (set! cursor-eles #f)
-                       (let ([f (get-top-level-window)])
-                         (when f
-                           (send f update-status-line 'drracket:check-syntax:mouse-over #f)))
                        (invalidate-bitmap-cache))
                      (super on-event event)]
                     [(or (send event moving?)
@@ -938,20 +934,18 @@ If the namespace does not, they are colored the unbound color.
                          (set! cursor-eles eles)
                          (update-docs-background eles)
                          (when eles
-                           (update-status-line eles)
+                           (update-tooltips eles)
                            (for ([ele (in-list eles)])
                              (cond [(arrow? ele)
                                     (update-arrow-poss ele)]))
                            (invalidate-bitmap-cache)))))]
                   [else
                    (update-docs-background #f)
-                   (let ([f (get-top-level-window)])
-                     (when f
-                       (send f update-status-line 'drracket:check-syntax:mouse-over #f)))
                    (when (or cursor-location cursor-text)
                      (set! cursor-location #f)
                      (set! cursor-text #f)
                      (set! cursor-eles #f)
+                     (clear-tooltips)
                      (invalidate-bitmap-cache))])))
 
             (define/public (syncheck:build-popup-menu pos text)
@@ -970,7 +964,8 @@ If the namespace does not, they are colored the unbound color.
                                       [arrows (filter arrow? vec-ents)]
                                       [def-links (filter def-link? vec-ents)]
                                       [var-arrows (filter var-arrow? arrows)]
-                                      [add-menus (map cdr (filter pair? vec-ents))])
+                                      [add-menus (append (map cdr (filter pair? vec-ents))
+                                                         (filter procedure? vec-ents))])
                                  (unless (null? arrows)
                                    (make-object menu-item%
                                      (string-constant cs-tack/untack-arrow)
@@ -1035,22 +1030,70 @@ If the namespace does not, they are colored the unbound color.
                                
                                  menu)]))))))
             
-            (define/private (update-status-line eles)
-              (let ([has-txt? #f])
-                (for-each (λ (ele)
-                            (cond
-                              [(string? ele)
-                               (set! has-txt? #t)
-                               (let ([f (get-top-level-window)])
-                                 (when f
-                                   (send f update-status-line 
-                                         'drracket:check-syntax:mouse-over 
-                                         ele)))]))
-                          eles)
-                (unless has-txt?
-                  (let ([f (get-top-level-window)])
-                    (when f
-                      (send f update-status-line 'drracket:check-syntax:mouse-over #f))))))
+            (define tooltip-frame #f)
+            (define/private (update-tooltips eles)
+              (unless tooltip-frame (set! tooltip-frame (new tooltip-frame%)))
+              (define tooltip-infos (filter tooltip-info? eles))
+              (cond
+                [(null? tooltip-infos)
+                 (send tooltip-frame show #f)]
+                [else
+                 (send tooltip-frame set-tooltip (map tooltip-info-msg tooltip-infos))
+                 (let loop ([tooltip-infos tooltip-infos]
+                            [l #f]
+                            [t #f]
+                            [r #f]
+                            [b #f])
+                   (cond
+                     [(null? tooltip-infos)
+                      (if (and l t r b)
+                          (send tooltip-frame show-over l t (- r l) (- b t))
+                          (send tooltip-frame show #f))]
+                     [else
+                      (define-values (tl tt tr tb) (tooltip-info->ltrb (car tooltip-infos)))
+                      (define (min/f x y) (cond [(and x y) (min x y)] [x x] [y y] [else #f]))
+                      (define (max/f x y) (cond [(and x y) (max x y)] [x x] [y y] [else #f]))
+                      (loop (cdr tooltip-infos)
+                            (min/f tl l)
+                            (min/f tt t)
+                            (max/f tr r)
+                            (max/f tb b))]))]))
+            
+            (define/private (clear-tooltips)
+              (when tooltip-frame (send tooltip-frame show #f)))
+
+            (define/private (tooltip-info->ltrb tooltip)
+              (define xlb (box 0))
+              (define ylb (box 0))
+              (define xrb (box 0))
+              (define yrb (box 0))
+              (define left-pos (tooltip-info-pos-left tooltip))
+              (define right-pos (tooltip-info-pos-right tooltip))
+              (define text (tooltip-info-text tooltip))
+              (send text position-location left-pos xlb ylb #t)
+              (send text position-location right-pos xrb yrb #f)
+              (define-values (xl-off yl-off) (send text editor-location-to-dc-location (unbox xlb) (unbox ylb)))
+              (define-values (xr-off yr-off) (send text editor-location-to-dc-location (unbox xrb) (unbox yrb)))
+              (define window
+                (let loop ([ed text])
+                  (cond
+                    [(send ed get-canvas) => values]
+                    [else
+                     (define admin (send ed get-admin))
+                     (if (is-a? admin editor-snip-editor-admin<%>)
+                         (loop (send (send admin get-snip) get-editor))
+                         #f)])))
+              (cond
+                [window
+                 (define (c n) (inexact->exact (round n)))
+                 (define-values (glx gly) (send window client->screen (c xl-off) (c yl-off)))
+                 (define-values (grx gry) (send window client->screen (c xr-off) (c yr-off)))
+                 (values (min glx grx)
+                         (min gly gry)
+                         (max glx grx)
+                         (max gly gry))]
+                [else
+                 (values #f #f #f #f)]))
             
             (define current-colored-region #f)
             ;; update-docs-background : (or/c false/c (listof any)) -> void
@@ -1711,6 +1754,7 @@ If the namespace does not, they are colored the unbound color.
                (define module-language?
                  (is-a? (drracket:language-configuration:language-settings-language settings)
                         drracket:module-language:module-language<%>))
+               (send definitions-text-copy set-style-list (send definitions-text get-style-list)) ;; speeds up the copy
                (send definitions-text copy-self-to definitions-text-copy)
                (with-lock/edit-sequence
                 definitions-text-copy
diff --git a/collects/drracket/private/syncheck/online-comp.rkt b/collects/drracket/private/syncheck/online-comp.rkt
index a4733f5cc5..a30cfe8a68 100644
--- a/collects/drracket/private/syncheck/online-comp.rkt
+++ b/collects/drracket/private/syncheck/online-comp.rkt
@@ -31,7 +31,7 @@
         (set! trace (cons (cons 'name args) trace))))
 
     ; (log syncheck:color-range) ;; we don't want log these as they are too distracting to keep popping up
-    ; (log syncheck:add-mouse-over-status) ;; we don't log these as they require space in the window
+    (log syncheck:add-mouse-over-status)
     (log syncheck:add-arrow)
     (log syncheck:add-tail-arrow)
     (log syncheck:add-background-color)
diff --git a/collects/drracket/private/syncheck/traversals.rkt b/collects/drracket/private/syncheck/traversals.rkt
index e156fd40da..e986f7f0e3 100644
--- a/collects/drracket/private/syncheck/traversals.rkt
+++ b/collects/drracket/private/syncheck/traversals.rkt
@@ -185,7 +185,7 @@
             (syntax-case* sexp (#%plain-lambda case-lambda if begin begin0 let-values letrec-values set!
                                                quote quote-syntax with-continuation-mark 
                                                #%plain-app #%top #%plain-module-begin
-                                               define-values define-syntaxes define-values-for-syntax module
+                                               define-values define-syntaxes begin-for-syntax module
                                                #%require #%provide #%expression)
               (if high-level? free-transformer-identifier=? free-identifier=?)
               [(#%plain-lambda args bodies ...)
@@ -317,12 +317,10 @@
                  (add-binders (syntax names) binders binding-inits #'exp)
                  (maybe-jump (syntax names))
                  (level-loop (syntax exp) #t))]
-              [(define-values-for-syntax names exp)
+              [(begin-for-syntax exp ...)
                (begin
                  (annotate-raw-keyword sexp varrefs)
-                 (add-binders (syntax names) high-binders binding-inits #'exp)
-                 (maybe-jump (syntax names))
-                 (level-loop (syntax exp) #t))]
+                 (for-each (lambda (e) (level-loop e #t)) (syntax->list (syntax (exp ...)))))]
               [(module m-name lang (#%plain-module-begin bodies ...))
                (begin
                  (annotate-raw-keyword sexp varrefs)
diff --git a/collects/drracket/private/tooltip.rkt b/collects/drracket/private/tooltip.rkt
new file mode 100644
index 0000000000..57196182f1
--- /dev/null
+++ b/collects/drracket/private/tooltip.rkt
@@ -0,0 +1,87 @@
+#lang racket/base
+(require racket/gui/base
+         racket/class)
+
+(provide tooltip-frame%)
+
+(define tooltip-frame%
+  (class frame%
+    (inherit show reflow-container move get-width get-height)
+    (define/override (on-subwindow-event r evt)
+      (cond
+        [(send evt button-down?)
+         (show #f)
+         #t]
+        [else #f]))
+    (define/public (set-tooltip ls) 
+      (send yellow-message set-lab ls))
+    
+    (define/public (show-over x y w h #:prefer-upper-left? [prefer-upper-left? #f])
+      (reflow-container)
+      (define mw (get-width))
+      (define mh (get-height))
+      (define (upper-left must?) 
+        (define the-x (- x mw))
+        (define the-y (- y mh))
+        (if must?
+            (move the-x the-y)
+            (try-moving-to the-x the-y mw mh)))
+      (define (lower-right must?) 
+        (define the-x (+ x w))
+        (define the-y (+ y h))
+        (if must?
+            (move the-x the-y)
+            (try-moving-to the-x the-y mw mh)))
+      (if prefer-upper-left?
+          (or (upper-left #t) (lower-right #f) (upper-left #t))
+          (or (lower-right #t) (upper-left #f) (lower-right #t)))
+      (show #t))
+    
+    (define/private (try-moving-to x y w h)
+      (and (for/or ([m (in-range 0 (get-display-count))])
+             (define-values (mx my) (get-display-left-top-inset #:monitor m))
+             (define-values (mw mh) (get-display-size #:monitor m))
+             (and (<= (- mx) x (+ x w) (+ (- mx) mw))
+                  (<= (- my) y (+ y h) (+ (- my) mh))))
+           (begin (move x y)
+                  #t)))
+
+    (super-new [style '(no-resize-border no-caption float)]
+               [label ""]
+               [stretchable-width #f]
+               [stretchable-height #f])
+    (define yellow-message (new yellow-message% [parent this]))))
+
+(define yellow-message%
+  (class canvas%
+    (inherit get-dc refresh get-client-size
+             min-width min-height
+             get-parent)
+    (define labels '(""))
+    (define/public (set-lab _ls) 
+      (unless (equal? labels _ls)
+        (set! labels _ls)
+        (update-size)
+        (refresh)))
+    (define/private (update-size)
+      (define dc (get-dc))
+      (send dc set-font small-control-font)
+      (define-values (w h _1 _2) (send dc get-text-extent (car labels)))
+      (send (get-parent) begin-container-sequence)
+      (min-width (+ 5 (inexact->exact (ceiling w))))
+      (min-height (+ 5 (* (length labels) (inexact->exact (ceiling h)))))
+      (send (get-parent) end-container-sequence)
+      (send (get-parent) reflow-container))
+    (define/override (on-paint)
+      (define dc (get-dc))
+      (send dc set-font small-control-font)
+      (define-values (w h) (get-client-size))
+      (define-values (tw th _1 _2) (send dc get-text-extent (car labels)))
+      (send dc set-pen "black" 1 'transparent)
+      (send dc set-brush "LemonChiffon" 'solid)
+      (send dc set-pen "black" 1 'solid)
+      (send dc draw-rectangle 0 0 w h)
+      (for ([label (in-list labels)]
+            [i (in-naturals)])
+        (send dc draw-text label 2 (+ 2 (* i th)))))
+    (super-new [stretchable-width #f] [stretchable-height #f])))
diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt
index 547643f8ea..8d8afe6504 100644
--- a/collects/drracket/private/unit.rkt
+++ b/collects/drracket/private/unit.rkt
@@ -150,7 +150,8 @@ module browser threading seems wrong.
                                      [else
                                       (message-box 
                                        (string-constant drscheme)
-                                       "Must choose a filename that ends with either .png, .jpg, .xbm, or .xpm")])))))]))))))
+                                       "Must choose a filename that ends with either .png, .jpg, .xbm, or .xpm"
+                                       #:dialog-mixin frame:focus-table-mixin)])))))]))))))
            
            (void))))))
   
@@ -338,7 +339,8 @@ module browser threading seems wrong.
                    (message-box
                     (string-constant drscheme)
                     v
-                    dlg)])))]
+                    dlg
+                    #:dialog-mixin frame:focus-table-mixin)])))]
            [cancel-callback 
             (λ () (send dlg show #f))])
       (let-values ([(ok cancel) 
@@ -364,7 +366,8 @@ module browser threading seems wrong.
         [(not program-filename)
          (message-box (string-constant create-executable-title)
                       (string-constant must-save-before-executable)
-                      frame)]
+                      frame
+                      #:dialog-mixin frame:focus-table-mixin)]
         [else
          (when (or (not (send definitions-text is-modified?))
                    (gui-utils:get-choice
@@ -1146,12 +1149,10 @@ module browser threading seems wrong.
       (define/public-final (set-i _i) (set! i _i))
       (define/public (disable-evaluation)
         (set! enabled? #f)
-        (send defs lock #t)
         (send ints lock #t)
         (send frame disable-evaluation-in-tab this))
       (define/public (enable-evaluation)
         (set! enabled? #t)
-        (send defs lock #f)
         (send ints lock #f)
         (send frame enable-evaluation-in-tab this))
       (define/public (get-enabled) enabled?)
@@ -1264,6 +1265,8 @@ module browser threading seems wrong.
       (define/public-final (toggle-log)
         (set! log-visible? (not log-visible?))
         (send frame show/hide-log log-visible?))
+      (define/public-final (hide-log)
+        (when log-visible? (toggle-log)))
       (define/public-final (update-log)
         (send frame show/hide-log log-visible?))
       (define/public-final (update-logger-window command)
@@ -1430,19 +1433,25 @@ module browser threading seems wrong.
                         (remq logger-panel l)])))]
             [else
              (when show? ;; if we want to hide and it isn't built yet, do nothing
+               (define logger-gui-tab-panel-parent (new horizontal-panel% [parent logger-panel] [stretchable-height #f]))
                (set! logger-gui-tab-panel
                      (new tab-panel% 
                           [choices (list (string-constant logging-all)
                                          "fatal" "error" "warning" "info" "debug")]
-                          [parent logger-panel]
+                          [parent logger-gui-tab-panel-parent]
+                          [stretchable-height #f]
+                          [style '(no-border)]
                           [callback
                            (λ (tp evt)
                              (preferences:set 'drracket:logger-gui-tab-panel-level (send logger-gui-tab-panel get-selection))
                              (update-logger-window #f))]))
+               (new button% [label (string-constant hide-log)]
+                    [callback (λ (x y) (send current-tab hide-log))]
+                    [parent logger-gui-tab-panel-parent])
                (send logger-gui-tab-panel set-selection (preferences:get 'drracket:logger-gui-tab-panel-level))
                (new-logger-text)
                (set! logger-gui-canvas 
-                     (new editor-canvas% [parent logger-gui-tab-panel] [editor logger-gui-text]))
+                     (new editor-canvas% [parent logger-panel] [editor logger-gui-text]))
                (send logger-menu-item set-label (string-constant hide-log))
                (update-logger-window #f)
                (send logger-parent-panel change-children (lambda (l) (append l (list logger-panel)))))])
@@ -1669,7 +1678,8 @@ module browser threading seems wrong.
                             (gui-utils:format-literal-label (string-constant erase-log-directory-contents)
                                                             transcript-directory)
                             this
-                            '(yes-no))])
+                            '(yes-no)
+                            #:dialog-mixin frame:focus-table-mixin)])
                 (cond
                   [(eq? query 'no) 
                    #f]
@@ -1682,7 +1692,8 @@ module browser threading seems wrong.
                                                                        (if (exn? exn)
                                                                            (format "~a" (exn-message exn))
                                                                            (format "~s" exn)))
-                                       this)
+                                       this
+                                       #:dialog-mixin frame:focus-table-mixin)
                                       #f)])
                      (for-each (λ (file) (delete-file (build-path transcript-directory file)))
                                dir-list)
@@ -2647,23 +2658,17 @@ module browser threading seems wrong.
           (send interactions-text reset-console)
           (send interactions-text clear-undos)
           
-          (let ([start 0])
-            (send definitions-text split-snip start)
-            (let* ([name (send definitions-text get-port-name)]
-                   [text-port (open-input-text-editor definitions-text start 'end values name #t)])
-              (port-count-lines! text-port)
-              (let* ([line (send definitions-text position-paragraph start)]
-                     [column (- start (send definitions-text paragraph-start-position line))]
-                     [relocated-port (relocate-input-port text-port 
-                                                          (+ line 1)
-                                                          column
-                                                          (+ start 1))])
-                (port-count-lines! relocated-port)
-                (send interactions-text evaluate-from-port
-                      relocated-port
-                      #t
-                      (λ ()
-                        (send interactions-text clear-undos))))))))
+          (define name (send definitions-text get-port-name))
+          (define defs-copy (new text%))
+          (send defs-copy set-style-list (send definitions-text get-style-list)) ;; speeds up the copy
+          (send definitions-text copy-self-to defs-copy)
+          (define text-port (open-input-text-editor defs-copy 0 'end values name #t))
+          (port-count-lines! text-port)
+          (send interactions-text evaluate-from-port
+                text-port
+                #t
+                (λ ()
+                  (send interactions-text clear-undos)))))
       
       (inherit revert save)
       (define/private (check-if-save-file-up-to-date)
@@ -2677,7 +2682,8 @@ module browser threading seems wrong.
                   #f
                   this
                   '(caution default=2 number-order)
-                  1)])
+                  1
+                  #:dialog-mixin frame:focus-table-mixin)])
             (case user-choice
               [(1) (void)]
               [(2) (revert)]))))
@@ -2983,22 +2989,33 @@ module browser threading seems wrong.
         (update-close-menu-item-shortcut (file-menu:get-close-item)))
       
       (define/private (update-close-tab-menu-item-shortcut item)
-        (let ([just-one? (and (pair? tabs) (null? (cdr tabs)))])
-          (send item set-label (if just-one? 
-                                   (string-constant close-tab)
-                                   (string-constant close-tab-amp)))
-          (when (preferences:get 'framework:menu-bindings)
-            (send item set-shortcut (if just-one? #f #\w)))))
+        (define just-one? (and (pair? tabs) (null? (cdr tabs))))
+        (send item set-label (if just-one? 
+                                 (string-constant close-tab)
+                                 (string-constant close-tab-amp)))
+        (when (preferences:get 'framework:menu-bindings)
+          (send item set-shortcut (if just-one? #f #\w))))
       
       (define/private (update-close-menu-item-shortcut item)
-        (let ([just-one? (and (pair? tabs) (null? (cdr tabs)))])
-          (send item set-label (if just-one? 
-                                   (string-constant close-menu-item)
-                                   (string-constant close)))
-          (when (preferences:get 'framework:menu-bindings)
-            (send item set-shortcut-prefix (if just-one? 
-                                               (get-default-shortcut-prefix) 
-                                               (cons 'shift (get-default-shortcut-prefix)))))))
+        (cond
+          [(eq? (system-type) 'unix)
+           (send item set-label (string-constant close-menu-item))]
+          [else
+           (define just-one? (and (pair? tabs) (null? (cdr tabs))))
+           (send item set-label (if just-one?
+                                    (string-constant close-window-menu-item)
+                                    (string-constant close-window)))
+           (when (preferences:get 'framework:menu-bindings)
+             (send item set-shortcut-prefix (if just-one? 
+                                                (get-default-shortcut-prefix) 
+                                                (cons 'shift (get-default-shortcut-prefix)))))]))
+      
+      (define/override (file-menu:close-callback item control)
+        (define just-one? (and (pair? tabs) (null? (cdr tabs))))
+        (if (and (eq? (system-type) 'unix)
+                   (not just-one?))
+            (close-current-tab)
+            (super file-menu:close-callback item control)))
       
       ;; offer-to-save-file : path -> void
       ;; bring the tab that edits the file named by `path' to the front
@@ -3113,8 +3130,7 @@ module browser threading seems wrong.
                    [label (string-constant show-log)]
                    [parent show-menu]
                    [callback
-                    (λ (x y) (send current-tab toggle-log))]))
-        )
+                    (λ (x y) (send current-tab toggle-log))])))
       
       
       ;                                                                                                       
@@ -3174,7 +3190,8 @@ module browser threading seems wrong.
                            strs))])
           (unless can-browse?
             (message-box (string-constant drscheme)
-                         (string-constant module-browser-only-in-plt-and-module-langs)))
+                         (string-constant module-browser-only-in-plt-and-module-langs)
+                         #:dialog-mixin frame:focus-table-mixin))
           can-browse?))
       
       (define/private (update-module-browser-pane)
@@ -3328,7 +3345,7 @@ module browser threading seems wrong.
         (set! file-menu:create-new-tab-item
               (new menu:can-restore-menu-item%
                    (label (string-constant new-tab))
-                   (shortcut #\=)
+                   (shortcut (if (preferences:get 'drracket:use-old-style-keybindings) #\= #\t))
                    (parent file-menu)
                    (callback
                     (λ (x y)
@@ -3339,16 +3356,17 @@ module browser threading seems wrong.
           (make-object separator-menu-item% file-menu))]
       (define close-tab-menu-item #f)
       (define/override (file-menu:between-close-and-quit file-menu)
-        (set! close-tab-menu-item
-              (new (get-menu-item%)
-                   (label (string-constant close-tab))
-                   (demand-callback
-                    (λ (item)
-                      (send item enable (1 . < . (send tabs-panel get-number)))))
-                   (parent file-menu)
-                   (callback
-                    (λ (x y)
-                      (close-current-tab)))))
+        (unless (eq? (system-type) 'unix)
+          (set! close-tab-menu-item
+                (new (get-menu-item%)
+                     (label (string-constant close-tab))
+                     (demand-callback
+                      (λ (item)
+                        (send item enable (1 . < . (send tabs-panel get-number)))))
+                     (parent file-menu)
+                     (callback
+                      (λ (x y)
+                        (close-current-tab))))))
         (super file-menu:between-close-and-quit file-menu))
       
       (define/override (file-menu:save-string) (string-constant save-definitions))
@@ -3406,8 +3424,13 @@ module browser threading seems wrong.
                         (preferences:get 'framework:print-output-mode)))))
         (super file-menu:between-print-and-close file-menu))
       
+      (inherit edit-menu:get-replace-item)
       (define/override (edit-menu:between-find-and-preferences edit-menu)
         (super edit-menu:between-find-and-preferences edit-menu)
+        (when (preferences:get 'drracket:use-old-style-keybindings)
+          (define item (edit-menu:get-replace-item)) 
+          (send item set-shortcut #\r)
+          (send item set-shortcut-prefix (get-default-shortcut-prefix))) 
         (new menu:can-restore-menu-item%
              [label (string-constant complete-word)]
              [shortcut #\/]
@@ -3573,7 +3596,8 @@ module browser threading seems wrong.
                                                                                     (send l capability-value 'drscheme:teachpack-menu-items)
                                                                                     (format "\n  ~a" (send l get-language-name))))
                                                                                  (drracket:language-configuration:get-languages))))))
-                                         this))])))])))
+                                         this
+                                         #:dialog-mixin frame:focus-table-mixin))])))])))
       
       (define/private (initialize-menus)
         (let* ([mb (get-menu-bar)]
@@ -3609,7 +3633,7 @@ module browser threading seems wrong.
                   (string-constant execute-menu-item-label)
                   language-specific-menu
                   (λ (_1 _2) (execute-callback))
-                  #\t
+                  (if (preferences:get 'drracket:use-old-style-keybindings) #\t #\r)
                   (string-constant execute-menu-item-help-string)))
           (make-object menu:can-restore-menu-item%
             (string-constant ask-quit-menu-item-label)
@@ -4646,8 +4670,9 @@ module browser threading seems wrong.
                  (frame:editor-mixin
                   (frame:standard-menus-mixin
                    (frame:register-group-mixin
-                    (frame:basic-mixin
-                     frame%))))))))))))))))))
+                    (frame:focus-table-mixin
+                     (frame:basic-mixin
+                      frame%)))))))))))))))))))
   
   (define-local-member-name enable-two-way-prefs)
   (define (make-two-way-prefs-dragable-panel% % pref-key)
diff --git a/collects/errortrace/stacktrace.rkt b/collects/errortrace/stacktrace.rkt
index 0a616764ef..3db268756b 100644
--- a/collects/errortrace/stacktrace.rkt
+++ b/collects/errortrace/stacktrace.rkt
@@ -377,17 +377,15 @@
              expr
              (rebuild disarmed-expr (list (cons #'rhs marked)))))]
          
-         [(define-values-for-syntax (name ...) rhs)
+         [(begin-for-syntax . exprs)
           top?
-          (let ([marked (with-mark expr
-                                   (annotate-named
-                                    (one-name (syntax (name ...)))
-                                    (syntax rhs)
-                                    (add1 phase)))])
-            (rearm
-             expr
-             (rebuild disarmed-expr (list (cons #'rhs marked)))))]
-         
+          (rearm
+           expr
+           (annotate-seq disarmed-expr
+                         (syntax exprs)
+                         annotate-top 
+                         (add1 phase)))]
+
          [(module name init-import mb)
           (syntax-case (disarm #'mb) ()
             [(__plain-module-begin body ...)
diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt
index 88de9a1db1..4352051fad 100644
--- a/collects/framework/main.rkt
+++ b/collects/framework/main.rkt
@@ -9,7 +9,12 @@
          framework/framework-unit
          framework/private/sig
          (for-syntax scheme/base)
-         scribble/srcdoc)
+         scribble/srcdoc) 
+
+;; these next two lines do a little dance to make the
+;; require/doc setup work out properly
+(require (prefix-in :: framework/private/focus-table))
+(define frame:lookup-focus-table ::frame:lookup-focus-table)
 
 (require framework/preferences
          framework/test
@@ -709,7 +714,24 @@
             @racket[bitmap% get-loaded-mask]) and @racket['large].}]
     
     Defaults to @racket[#f].})
-
+ 
+ (proc-doc/names
+  frame:lookup-focus-table
+  (->* () (eventspace?) (listof (is-a?/c frame:focus-table<%>)))
+  (()
+   ((eventspace (current-eventspace))))
+  @{Returns a list of the frames in @racket[eventspace], where the first element of the list
+    is the frame with the focus.
+    
+    The order and contents of the list are maintained by
+    the methods in @racket[frame:focus-table-mixin], meaning that the
+    OS-level callbacks that track the focus of individual frames is 
+    ignored.
+    
+    See also @racket[test:use-focus-table] and @racket[test:get-active-top-level-window].
+    
+    })
+ 
  (proc-doc/names
   group:get-the-frame-group
   (-> (is-a?/c group:%))
diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt
index b850d9b69a..91e8ac8b7f 100644
--- a/collects/framework/private/color.rkt
+++ b/collects/framework/private/color.rkt
@@ -638,7 +638,8 @@ added get-regions
                                    (if (is-a? color color%)
                                        color
                                        (if color mismatch-color (get-match-color)))
-                                   (= caret-pos (+ start-pos start)))])
+                                   (= caret-pos (+ start-pos start))
+                                   'low)])
         (set! clear-old-locations
               (let ([old clear-old-locations])
                 (λ ()
diff --git a/collects/framework/private/finder.rkt b/collects/framework/private/finder.rkt
index 8b5675e986..ac020ee37f 100644
--- a/collects/framework/private/finder.rkt
+++ b/collects/framework/private/finder.rkt
@@ -1,14 +1,15 @@
 #lang scheme/unit
 
   (require string-constants
+           (prefix-in r: racket/gui/base)
            "sig.rkt"
            "../preferences.rkt"
            mred/mred-sig
            scheme/path)
   
-  
   (import mred^
-          [prefix keymap: framework:keymap^])
+          [prefix keymap: framework:keymap^]
+          [prefix frame: framework:frame^])
   
   (export (rename framework:finder^
                   [-put-file put-file]
@@ -44,7 +45,8 @@
              [name (or (and (string? name) (file-name-from-path name))
                        name)]
              [f (put-file prompt parent-win directory name
-                          (default-extension) style (default-filters))])
+                          (default-extension) style (default-filters)
+                          #:dialog-mixin frame:focus-table-mixin)])
         (and f (or (not filter) (filter-match? filter f filter-msg))
              (let* ([f (normal-case-path (simple-form-path f))]
                     [dir (path-only f)]
@@ -60,6 +62,7 @@
                   #f]
                  [else f]))))))
   
+  (define op (current-output-port))
   (define (*get-file style)
     (lambda ([directory #f]
              [prompt (string-constant select-file)]
@@ -67,7 +70,8 @@
              [filter-msg (string-constant file-wrong-form)]
              [parent-win (dialog-parent-parameter)])
       (let ([f (get-file prompt parent-win directory #f
-                         (default-extension) style (default-filters))])
+                         (default-extension) style (default-filters)
+                         #:dialog-mixin frame:focus-table-mixin)])
         (and f (or (not filter) (filter-match? filter f filter-msg))
              (cond [(directory-exists? f)
                     (message-box (string-constant error)
diff --git a/collects/framework/private/focus-table.rkt b/collects/framework/private/focus-table.rkt
new file mode 100644
index 0000000000..e29bb2cbf7
--- /dev/null
+++ b/collects/framework/private/focus-table.rkt
@@ -0,0 +1,13 @@
+#lang racket/base
+(require racket/gui/base racket/class)
+(provide frame:lookup-focus-table
+         frame:set-focus-table)
+
+;; focus-table : hash[eventspace -o> (listof frame)]
+(define focus-table (make-hash))
+(define (frame:lookup-focus-table [eventspace (current-eventspace)])
+  (hash-ref focus-table eventspace '()))
+(define (frame:set-focus-table eventspace new)
+  (if (null? new)
+      (hash-remove! focus-table eventspace)
+      (hash-set! focus-table eventspace new)))
diff --git a/collects/framework/private/frame.rkt b/collects/framework/private/frame.rkt
index b051dea8a8..9930c009a1 100644
--- a/collects/framework/private/frame.rkt
+++ b/collects/framework/private/frame.rkt
@@ -9,6 +9,7 @@
          "../preferences.rkt"
          "../gui-utils.rkt"
          "bday.rkt"
+         framework/private/focus-table
          mrlib/close-icon
          mred/mred-sig
          scheme/path)
@@ -131,6 +132,26 @@
                    editing-this-file?
                    get-filename
                    make-visible))
+
+(define focus-table<%> (interface (top-level-window<%>)))
+(define focus-table-mixin
+  (mixin (top-level-window<%>) (focus-table<%>)
+    (inherit get-eventspace)
+    
+    (define/override (show on?)
+      (define old (remove this (frame:lookup-focus-table (get-eventspace))))
+      (define new (if on? (cons this old) old))
+      (frame:set-focus-table (get-eventspace) new)
+      (super show on?))
+    
+    (define/augment (on-close)
+      (frame:set-focus-table (get-eventspace) (remove this (frame:lookup-focus-table (get-eventspace))))
+      (inner (void) on-close))
+    
+    (super-new)
+    
+    (frame:set-focus-table (get-eventspace) (frame:lookup-focus-table (get-eventspace)))))
+
 (define basic-mixin
   (mixin ((class->interface frame%)) (basic<%>)
     
@@ -190,12 +211,11 @@
       (λ (% parent)
         (make-object % parent)))
     
-    (inherit can-close? on-close)
-    (define/public close
-      (λ ()
-        (when (can-close?)
-          (on-close)
-          (show #f))))
+    (inherit on-close can-close?)
+    (define/public (close)
+      (when (can-close?)
+        (on-close)
+        (show #f)))
     
     (inherit accept-drop-files)
     
@@ -2710,7 +2730,7 @@
     (min-width (+ (inexact->exact (ceiling indicator-width)) 4))
     (min-height (+ (inexact->exact (ceiling indicator-height)) 4))))
 
-(define basic% (register-group-mixin (basic-mixin frame%)))
+(define basic% (focus-table-mixin (register-group-mixin (basic-mixin frame%))))
 (define size-pref% (size-pref-mixin basic%))
 (define info% (info-mixin basic%))
 (define text-info% (text-info-mixin info%))
diff --git a/collects/framework/private/handler.rkt b/collects/framework/private/handler.rkt
index 3c06dfa589..8f49494b4c 100644
--- a/collects/framework/private/handler.rkt
+++ b/collects/framework/private/handler.rkt
@@ -120,25 +120,29 @@
 
 ;; add-to-recent : path -> void
 (define (add-to-recent filename)
-  (let* ([old-list (preferences:get 'framework:recently-opened-files/pos)]
-         [old-ents (filter (λ (x) (string=? (path->string (car x))
-                                            (path->string filename)))
-                           old-list)]
-         [old-ent (if (null? old-ents)
-                      #f
-                      (car old-ents))]
-         [new-ent (list filename
-                        (if old-ent (cadr old-ent) 0)
-                        (if old-ent (caddr old-ent) 0))]
-         [added-in (cons new-ent
-                         (remove new-ent old-list compare-recent-list-items))]
-         [new-recent (size-down added-in
-                                (preferences:get 'framework:recent-max-count))])
-    (preferences:set 'framework:recently-opened-files/pos new-recent)))
+  
+  (define old-list (preferences:get 'framework:recently-opened-files/pos))
+  (define old-ents (filter (λ (x) (recently-opened-files-same-enough-path? (car x) filename))
+                           old-list))
+  (define new-ent (if (null? old-ents)
+                      (list filename 0 0)
+                      (cons filename (cdr (car old-ents)))))
+  (define added-in (cons new-ent
+                         (remove* (list new-ent)
+                                  old-list 
+                                  (λ (l1 l2) 
+                                    (recently-opened-files-same-enough-path? (car l1) (car l2))))))
+  (define new-recent (size-down added-in
+                                (preferences:get 'framework:recent-max-count)))
+  (preferences:set 'framework:recently-opened-files/pos new-recent))
+
+;; same-enough-path? : path path -> boolean
+;; used to determine if the open-recent-files menu item considers two paths to be the same
+(define (recently-opened-files-same-enough-path? p1 p2)
+  (equal? (simplify-path (normal-case-path p1) #f)
+          (simplify-path (normal-case-path p2) #f)))
+
 
-;; compare-recent-list-items : recent-list-item recent-list-item -> boolean
-(define (compare-recent-list-items l1 l2)
-  (equal? (car l1) (car l2)))
 
 ;; size-down : (listof X) -> (listof X)[< recent-max-count]
 ;; takes a list of stuff and returns the
@@ -167,8 +171,8 @@
           (preferences:get 'framework:recently-opened-files/pos)]
          [new-recent-items
           (map (λ (x)
-                 (if (string=? (path->string (car x))
-                               (path->string filename))
+                 (if (recently-opened-files-same-enough-path? (path->string (car x))
+                                                              (path->string filename))
                      (list* (car x) start end (cdddr x))
                      x))
                (preferences:get 'framework:recently-opened-files/pos))])
@@ -198,9 +202,8 @@
 
 (define (recent-list-item->menu-label recent-list-item)
   (let ([filename (car recent-list-item)])
-    (gui-utils:trim-string
-     (regexp-replace* #rx"&" (path->string filename) "\\&\\&")
-     200)))
+    (gui-utils:quote-literal-label
+     (path->string filename))))
 
 ;; this function must mimic what happens in install-recent-items
 ;; it returns #t if all of the labels of menus are the same, or approximation to
@@ -232,8 +235,12 @@
                (send ed set-position start end)))))]
       [else
        (preferences:set 'framework:recently-opened-files/pos
-                        (remove recent-list-item
-                                (preferences:get 'framework:recently-opened-files/pos)))
+                        (remove* (list recent-list-item)
+                                 (preferences:get 'framework:recently-opened-files/pos)
+                                 (λ (l1 l2)
+                                   (recently-opened-files-same-enough-path?
+                                    (car l1)
+                                    (car l2)))))
        (message-box (string-constant error)
                     (format (string-constant cannot-open-because-dne)
                             filename))])))
diff --git a/collects/framework/private/sig.rkt b/collects/framework/private/sig.rkt
index 60520eeb3f..aa76198d74 100644
--- a/collects/framework/private/sig.rkt
+++ b/collects/framework/private/sig.rkt
@@ -256,6 +256,7 @@
   
   (define-signature frame-class^
     (basic<%>
+     focus-table<%>
      size-pref<%>
      register-group<%>
      status-line<%>
@@ -285,6 +286,7 @@
      delegate%
      pasteboard%
      
+     focus-table-mixin
      basic-mixin
      size-pref-mixin
      register-group-mixin
diff --git a/collects/framework/private/standard-menus-items.rkt b/collects/framework/private/standard-menus-items.rkt
index 74769ec4de..10fbca7b56 100644
--- a/collects/framework/private/standard-menus-items.rkt
+++ b/collects/framework/private/standard-menus-items.rkt
@@ -265,7 +265,9 @@
                       '(λ (item control) (when (can-close?) (on-close) (show #f)) #t)
                       #\w
                       '(get-default-shortcut-prefix)
-                      '(string-constant close-menu-item)
+                      '(if (eq? (system-type) 'unix)
+                           (string-constant close-menu-item)
+                           (string-constant close-window-menu-item))
                       on-demand-do-nothing
                       #t)
         (make-between 'file-menu 'close 'quit 'nothing)
@@ -387,8 +389,8 @@
         (make-an-item 'edit-menu 'replace
                       '(string-constant replace-info)
                       '(λ (item control) (void))
-                      #\r
-                      '(get-default-shortcut-prefix)
+                      #\f
+                      '(cons 'shift (get-default-shortcut-prefix))
                       '(string-constant replace-menu-item)
                       on-demand-do-nothing
                       #f)
diff --git a/collects/framework/private/standard-menus.rkt b/collects/framework/private/standard-menus.rkt
index ddb0aabebe..9e9a48b7c6 100644
--- a/collects/framework/private/standard-menus.rkt
+++ b/collects/framework/private/standard-menus.rkt
@@ -272,7 +272,11 @@
     file-menu:close-callback
     (λ (item control) (when (can-close?) (on-close) (show #f)) #t))
    (define/public (file-menu:get-close-item) file-menu:close-item)
-   (define/public (file-menu:close-string) (string-constant close-menu-item))
+   (define/public
+    (file-menu:close-string)
+    (if (eq? (system-type) 'unix)
+      (string-constant close-menu-item)
+      (string-constant close-window-menu-item)))
    (define/public (file-menu:close-help-string) (string-constant close-info))
    (define/public file-menu:close-on-demand (λ (menu-item) (void)))
    (define/public (file-menu:create-close?) #t)
@@ -911,8 +915,8 @@
             (let ((edit-menu:replace-callback
                    (λ (item evt) (edit-menu:replace-callback item evt))))
               edit-menu:replace-callback))
-           (shortcut #\r)
-           (shortcut-prefix (get-default-shortcut-prefix))
+           (shortcut #\f)
+           (shortcut-prefix (cons 'shift (get-default-shortcut-prefix)))
            (help-string (edit-menu:replace-help-string))
            (demand-callback
             (λ (menu-item) (edit-menu:replace-on-demand menu-item))))))
diff --git a/collects/framework/test.rkt b/collects/framework/test.rkt
index fe4bf793ca..df53fc681a 100644
--- a/collects/framework/test.rkt
+++ b/collects/framework/test.rkt
@@ -1,10 +1,12 @@
 #lang at-exp scheme/gui
 
-(require scribble/srcdoc)
-(require/doc scheme/base scribble/manual)
+(require scribble/srcdoc
+         (prefix-in :: framework/private/focus-table))
+(require/doc scheme/base scribble/manual
+             (for-label framework))
 
 (define (test:top-level-focus-window-has? pred)
-  (let ([tlw (get-top-level-focus-window)])
+  (let ([tlw (test:get-active-top-level-window)])
     (and tlw
          (let loop ([tlw tlw])
            (or (pred tlw)
@@ -165,16 +167,30 @@
 (define current-get-eventspaces
   (make-parameter (λ () (list (current-eventspace)))))
 
-(define (get-active-frame)
+(define test:use-focus-table (make-parameter #f))
+
+(define (test:get-active-top-level-window)
   (ormap (λ (eventspace)
            (parameterize ([current-eventspace eventspace])
-             (get-top-level-focus-window)))
+             (cond
+               [(test:use-focus-table)
+                (define lst (::frame:lookup-focus-table))
+                (define focusd (and (not (null? lst)) (car lst)))
+                (when (eq? (test:use-focus-table) 'debug)
+                  (define f2 (get-top-level-focus-window))
+                  (unless (eq? focusd f2)
+                    (eprintf "found mismatch focus-table: ~s vs get-top-level-focus-window: ~s\n" 
+                             (map (λ (x) (send x get-label)) lst) 
+                             (and f2 (list (send f2 get-label))))))
+                focusd]
+               [else
+                (get-top-level-focus-window)])))
          ((current-get-eventspaces))))
 
 (define (get-focused-window)
-  (let ([f (get-active-frame)])
+  (let ([f (test:get-active-top-level-window)])
     (and f
-         (send f get-focus-window))))
+         (send f get-edit-target-window))))
 
 (define time-stamp current-milliseconds)
 
@@ -200,14 +216,13 @@
 ;; get-parent returns () for no parent.
 ;;
 
-(define in-active-frame?
-  (λ (window)
-    (let ([frame  (get-active-frame)])
-      (let loop ([window  window])
-        (cond [(not window) #f]
-              [(null? window) #f]  ;; is this test needed?
-              [(eq? window frame) #t]
-              [else  (loop (send window get-parent))])))))
+(define (in-active-frame? window)
+  (let ([frame  (test:get-active-top-level-window)])
+    (let loop ([window  window])
+      (cond [(not window) #f]
+            [(null? window) #f]  ;; is this test needed?
+            [(eq? window frame) #t]
+            [else  (loop (send window get-parent))]))))
 
 ;;
 ;; Verify modifier list.
@@ -239,7 +254,7 @@
     (cond
       [(or (string? b-desc)
            (procedure? b-desc))
-       (let* ([active-frame (get-active-frame)]
+       (let* ([active-frame (test:get-active-top-level-window)]
               [_ (unless active-frame
                    (error object-tag
                           "could not find object: ~a, no active frame" 
@@ -516,7 +531,7 @@
              [else 
               (error
                key-tag
-               "focused window is not a text-field% and does not have on-char")])]
+               "focused window is not a text-field% and does not have on-char, ~e" window)])]
           [(send (car l) on-subwindow-char window event) #f]
           [else (loop (cdr l))])))
 
@@ -573,21 +588,20 @@
 
 (define menu-tag 'test:menu-select)
 
-(define menu-select
-  (λ (menu-name . item-names)
-    (cond
-      [(not (string? menu-name))
-       (error menu-tag "expects string, given: ~e" menu-name)]
-      [(not (andmap string? item-names))
-       (error menu-tag "expects strings, given: ~e" item-names)]
-      [else
-       (run-one
-        (λ ()
-          (let* ([frame (get-active-frame)]
-                 [item (get-menu-item frame (cons menu-name item-names))]
-                 [evt (make-object control-event% 'menu)])
-            (send evt set-time-stamp (current-milliseconds))
-            (send item command evt))))])))
+(define (menu-select menu-name . item-names)
+  (cond
+    [(not (string? menu-name))
+     (error menu-tag "expects string, given: ~e" menu-name)]
+    [(not (andmap string? item-names))
+     (error menu-tag "expects strings, given: ~e" item-names)]
+    [else
+     (run-one
+      (λ ()
+        (let* ([frame (test:get-active-top-level-window)]
+               [item (get-menu-item frame (cons menu-name item-names))]
+               [evt (make-object control-event% 'menu)])
+          (send evt set-time-stamp (current-milliseconds))
+          (send item command evt))))]))
 
 (define get-menu-item
   (λ (frame item-names)
@@ -1021,7 +1035,7 @@
   test:top-level-focus-window-has?
   (-> (-> (is-a?/c area<%>) boolean?) boolean?)
   (test)
-  @{Calls @racket[test] for each child of the top-level-focus-frame
+  @{Calls @racket[test] for each child of the @racket[test:get-active-top-level-window]
           and returns @racket[#t] if @racket[test] ever does, otherwise
           returns @racket[#f]. If there
           is no top-level-focus-window, returns @racket[#f].})
@@ -1041,4 +1055,20 @@
   test:run-one
   (-> (-> void?) void?)
   (f)
-  @{Runs the function @racket[f] as if it was a simulated event.}))
+  @{Runs the function @racket[f] as if it was a simulated event.})
+ 
+ (parameter-doc
+  test:use-focus-table
+  (parameter/c (or/c boolean? 'debug))
+  use-focus-table?
+  @{If @racket[#t], then the test framework uses @racket[frame:lookup-focus-table] to determine
+    which is the focused frame. If @racket[#f], then it uses @racket[get-top-level-focus-window].
+    If @racket[test:use-focus-table]'s value is @racket['debug], then it still uses 
+    @racket[frame:lookup-focus-table] but it also prints a message to the @racket[current-error-port]
+    when the two methods would give different results.})
+ 
+ (proc-doc/names
+  test:get-active-top-level-window
+  (-> (or/c (is-a?/c frame%) (is-a?/c dialog%) #f))
+  ()
+  @{Returns the frontmost frame, based on @racket[test:use-focus-table].}))
diff --git a/collects/gui-debugger/annotator.rkt b/collects/gui-debugger/annotator.rkt
index cc96b2afc6..af0f87fb15 100644
--- a/collects/gui-debugger/annotator.rkt
+++ b/collects/gui-debugger/annotator.rkt
@@ -203,9 +203,8 @@
           ]
          [(define-syntaxes (var ...) expr)
           stx]
-         [(define-values-for-syntax (var ...) expr)
-          ;; define-values-for-syntax's RHS is compile time, so treat it
-          ;; like define-syntaxes
+         [(begin-for-syntax . exprs)
+          ;; compile time, so treat it like define-syntaxes
           stx]
          [(begin . top-level-exprs)
           (quasisyntax/loc stx (begin #,@(map (lambda (expr)
diff --git a/collects/gui-debugger/debug-tool.rkt b/collects/gui-debugger/debug-tool.rkt
index cc4757977d..0ca426e48e 100644
--- a/collects/gui-debugger/debug-tool.rkt
+++ b/collects/gui-debugger/debug-tool.rkt
@@ -132,6 +132,10 @@
                                     (> size (vector-length v)))
                                '...
                                (truncate-value (vector-ref v i) size (sub1 depth)))))]
+          [(bytes? v)
+           (if (> (bytes-length v) size)
+               (bytes-append (subbytes v 0 size) #"...")
+               v)]
           [else v]))
       
       (define filename->defs
@@ -1141,7 +1145,7 @@
             (for-each
              (lambda (name/value)
                (let ([name (format "~a" (syntax-e (first name/value)))]
-                     [value (format " => ~s\n" (second name/value))])
+                     [value (format " => ~s\n" (truncate-value (second name/value) 100 5))])
                  (send variables-text insert name)
                  (send variables-text change-style bold-sd
                        (- (send variables-text last-position) (string-length name))
diff --git a/collects/honu/core/language.rkt b/collects/honu/core/language.rkt
index 9ad2e7b29c..a5c303e543 100644
--- a/collects/honu/core/language.rkt
+++ b/collects/honu/core/language.rkt
@@ -4,8 +4,16 @@
 
 (provide honu-info)
 (define (honu-info key default default-filter)
+  ; (printf "get info for ~a\n" key)
   (case key
     [(color-lexer) (dynamic-require 'honu/core/read
                                     'color-lexer)]
     [else
       (default-filter key default)]))
+
+(provide honu-language-info)
+(define (honu-language-info data)
+  (lambda (key default)
+    (case key
+      [(configure-runtime) '(#(honu/core/runtime configure #f))]
+      [else default])))
diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt
index 74c6f94f58..da33167812 100644
--- a/collects/honu/core/main.rkt
+++ b/collects/honu/core/main.rkt
@@ -2,13 +2,19 @@
 
 (require "private/honu-typed-scheme.rkt"
          "private/honu2.rkt"
+         "private/macro2.rkt"
+         (for-syntax (only-in "private/parse2.rkt" honu-expression))
          (prefix-in literal: "private/literals.rkt"))
 
 (provide #%top
          #%datum
          print printf true false
+         (for-syntax (rename-out [honu-expression expression]))
          (rename-out [#%dynamic-honu-module-begin #%module-begin]
+                     [honu-top-interaction #%top-interaction]
                      [honu-function function]
+                     [honu-macro macro]
+                     [honu-syntax syntax]
                      [honu-var var]
                      [honu-val val]
                      [honu-for for]
@@ -21,6 +27,7 @@
                      [honu-> >] [honu-< <]
                      [honu->= >=] [honu-<= <=]
                      [honu-= =]
+                     [honu-assignment :=]
                      [literal:honu-<- <-]
                      [honu-map map]
                      [honu-flow \|]
diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt
index 8113b5e43d..118244f34b 100644
--- a/collects/honu/core/private/honu-typed-scheme.rkt
+++ b/collects/honu/core/private/honu-typed-scheme.rkt
@@ -445,21 +445,26 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
          #'rest)])))
 
 (define-for-syntax (honu-expand forms)
-  (parse-all forms))
+  (parse-one forms))
 
 (define-for-syntax (honu-compile forms)
   #'(void))
 
-
 (define-syntax (honu-unparsed-begin stx)
   (emit-remark "Honu unparsed begin!" stx)
   (debug "honu unparsed begin: ~a at phase ~a\n" (syntax->datum stx) (syntax-local-phase-level))
   (syntax-parse stx
     [(_) #'(void)]
     [(_ forms ...)
-     (define expanded (honu-expand #'(forms ...)))
-     (debug "expanded ~a\n" (syntax->datum expanded))
-     expanded]))
+     (define-values (parsed unparsed) (honu-expand #'(forms ...)))
+     (debug "expanded ~a unexpanded ~a\n"
+            (syntax->datum parsed)
+            (syntax->datum unparsed))
+     (with-syntax ([parsed parsed]
+                   [(unparsed ...) unparsed])
+       (if (null? (syntax->datum #'(unparsed ...)))
+         #'parsed
+         #'(begin parsed (honu-unparsed-begin unparsed ...))))]))
 
 (define-syntax (#%dynamic-honu-module-begin stx)
   (syntax-case stx ()
diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt
index d065506d3d..3a80e69957 100644
--- a/collects/honu/core/private/honu2.rkt
+++ b/collects/honu/core/private/honu2.rkt
@@ -3,6 +3,7 @@
 (require "macro2.rkt"
          "operator.rkt"
          "struct.rkt"
+         "honu-typed-scheme.rkt"
          (only-in "literals.rkt"
                   honu-then
                   semicolon)
@@ -136,6 +137,13 @@
                   [right right])
       #'(right left))))
 
+(provide honu-assignment)
+(define-honu-operator/syntax honu-assignment 0.0001 'left
+  (lambda (left right)
+    (with-syntax ([left left]
+                  [right right])
+      #'(set! left right))))
+
 (define-binary-operator honu-+ 1 'left +)
 (define-binary-operator honu-- 1 'left -)
 (define-binary-operator honu-* 2 'left *)
@@ -152,3 +160,9 @@
 (define-binary-operator honu-map 0.09 'left map)
 
 (define-unary-operator honu-not 0.7 'left not)
+
+(provide honu-top-interaction)
+(define-syntax (honu-top-interaction stx)
+  (syntax-case stx ()
+    [(_ rest ...)
+     #'(#%top-interaction . (honu-unparsed-begin rest ...))]))
diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt
index 72d3edf7c6..60a799978a 100644
--- a/collects/honu/core/private/macro2.rkt
+++ b/collects/honu/core/private/macro2.rkt
@@ -3,6 +3,7 @@
 (require (for-syntax "transformer.rkt"
                      syntax/define
                      syntax/parse
+                     syntax/stx
                      "literals.rkt"
                      "parse2.rkt"
                      "debug.rkt"
@@ -17,30 +18,39 @@
       (syntax/loc stx
                  (define-syntax id (make-honu-transformer rhs))))))
 
-(define-for-syntax (convert-pattern pattern)
-  (syntax-parse pattern
-    [(name semicolon class)
-     #'(~var name class)]))
+(define-for-syntax (convert-pattern original-pattern)
+  (define-splicing-syntax-class pattern-type
+    #:literal-sets (cruft)
+    [pattern (~seq name colon class)
+             #:with result #'(~var name class #:attr-name-separator "_")]
+    [pattern x #:with result #'x])
+  (syntax-parse original-pattern
+    [(thing:pattern-type ...)
+     #'(thing.result ...)]))
 
-(provide macro)
-(define-honu-syntax macro 
+(provide honu-macro)
+(define-honu-syntax honu-macro 
   (lambda (code context)
     (debug "Macroize ~a\n" code)
     (syntax-parse code #:literal-sets (cruft)
       [(_ name literals (#%braces pattern ...) (#%braces action ...) . rest)
        (debug "Pattern is ~a\n" #'(pattern ...))
        (values
-         (with-syntax ([syntax-parse-pattern
+         (with-syntax ([(syntax-parse-pattern ...)
                          (convert-pattern #'(pattern ...))])
            #'(define-honu-syntax name
                (lambda (stx context-name)
                  (syntax-parse stx
-                   [(_ syntax-parse-pattern . more)
+                   [(_ syntax-parse-pattern ... . more)
                     (values #'(let-syntax ([do-parse (lambda (stx)
-                                                       (parse-all stx))])
+                                                       (define what (parse-all (stx-cdr stx)))
+                                                       (debug "Macro parse all ~a\n" what)
+                                                       what)])
                                 (do-parse action ...))
-                            #'more)]))))
-         #'rest)])))
+                            #'more
+                            #t)]))))
+         #'rest
+         #t)])))
 
 (provide (rename-out [honu-with-syntax withSyntax]))
 (define-honu-syntax honu-with-syntax
@@ -49,3 +59,18 @@
       [(_ [#%brackets name:id data]
           (#%braces code ...))
        #'(with-syntax ([name data]) code ...)])))
+
+(define-syntax (parse-stuff stx)
+  (syntax-parse stx
+    [(_ stuff ...)
+     (parse-all #'(stuff ...))]))
+
+(provide honu-syntax)
+(define-honu-syntax honu-syntax
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ (#%parens stuff ...) . rest)
+       (values
+         #'(parse-stuff stuff ...)
+         #'rest
+         #f)])))
diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt
index 142f60586b..e0ca3c8d98 100644
--- a/collects/honu/core/private/parse2.rkt
+++ b/collects/honu/core/private/parse2.rkt
@@ -120,6 +120,13 @@
           (loop (cons parsed used)
                 unparsed))))))
 
+(define parsed-property (gensym 'honu-parsed))
+(define (parsed-syntax syntax)
+  (syntax-property syntax parsed-property #t))
+
+(define (parsed-syntax? syntax)
+  (syntax-property syntax parsed-property))
+
 (define (stopper? what)
   (define-literal-set check (honu-comma semicolon colon))
   (define is (and (identifier? what)
@@ -178,6 +185,8 @@
                           #'rest)
                   (do-parse #'rest precedence
                             left #'parsed)))))]
+         [(parsed-syntax? #'head)
+          (do-parse #'(rest ...) precedence left #'head)]
          [(honu-operator? #'head)
           (define new-precedence (transformer:honu-operator-ref (syntax-local-value #'head) 0))
           (define association (transformer:honu-operator-ref (syntax-local-value #'head) 1))
@@ -283,13 +292,20 @@
                       (error 'parse "function call")]
                      [else (error 'what "dont know how to parse ~a" #'head)])])])]))
 
-  (do-parse input 0 (lambda (x) x) #f))
+  (define-values (parsed unparsed)
+                 (do-parse input 0 (lambda (x) x) #f))
+  (values (parsed-syntax parsed)
+          unparsed))
 
 (define (empty-syntax? what)
   (syntax-parse what
     [() #t]
     [else #f]))
 
+(provide parse-one)
+(define (parse-one code)
+  (parse (strip-stops code)))
+
 (define (parse-all code)
   (let loop ([all '()]
              [code code])
diff --git a/collects/honu/core/private/util.rkt b/collects/honu/core/private/util.rkt
index d6e45b9e05..c26b441106 100644
--- a/collects/honu/core/private/util.rkt
+++ b/collects/honu/core/private/util.rkt
@@ -2,7 +2,6 @@
 
 (provide (except-out (all-defined-out) test-delimiter))
 (require "debug.rkt"
-         tests/eli-tester
          racket/match
          (for-syntax racket/base)
          syntax/stx
diff --git a/collects/honu/core/read.rkt b/collects/honu/core/read.rkt
index 846b1dfa33..c0caa43a23 100644
--- a/collects/honu/core/read.rkt
+++ b/collects/honu/core/read.rkt
@@ -34,7 +34,7 @@
                                          (:~ #\")))
 (define-lex-abbrev string (:: #\" (:* string-character) #\"))
 (define-lex-abbrev operator (:or "+" "=" "*" "/" "-" "^" "||" "|" "&&" "<="
-                                 ">=" "<-" "<" ">" "!" "::"))
+                                 ">=" "<-" "<" ">" "!" "::" ":="))
 (define-lex-abbrev block-comment (:: "/*"
                                      (complement (:: any-string "*/" any-string))
                                      "*/"))
@@ -42,7 +42,7 @@
 (define-lex-abbrev line-comment (:: (:or "#" "//")
                                     (:* (:~ "\n"))
                                     ;; we might hit eof before a \n
-                                    (:? "\n")))
+                                    (:? "\n" "\r")))
 
 (define (replace-escapes string)
   (define replacements '([#px"\\\\n" "\n"]
@@ -60,7 +60,7 @@
     #;
     [line-comment (token-whitespace)]
     [(:or "#" "//") (token-end-of-line-comment)]
-    ["\n" (token-whitespace)]
+    [(:? "\n" "\r") (token-whitespace)]
     [number (token-number (string->number lexeme))]
     #;
     [block-comment (token-whitespace)]
diff --git a/collects/honu/core/runtime.rkt b/collects/honu/core/runtime.rkt
new file mode 100644
index 0000000000..439689306e
--- /dev/null
+++ b/collects/honu/core/runtime.rkt
@@ -0,0 +1,7 @@
+#lang racket/base
+
+(require "read.rkt")
+
+(provide configure)
+(define (configure . args)
+  (current-read-interaction honu-read-syntax))
diff --git a/collects/honu/lang/reader.rkt b/collects/honu/lang/reader.rkt
index e813f69486..ed19d2233a 100644
--- a/collects/honu/lang/reader.rkt
+++ b/collects/honu/lang/reader.rkt
@@ -6,6 +6,7 @@ honu
 #:read-syntax honu-read-syntax
 #:whole-body-readers? #t
 #:info honu-info
+#:language-info #(honu/core/language honu-language-info #f)
 
 (require "../core/read.rkt"
          "../core/language.rkt")
diff --git a/collects/honu/main.rkt b/collects/honu/main.rkt
index c12adfe05c..d0575841c7 100644
--- a/collects/honu/main.rkt
+++ b/collects/honu/main.rkt
@@ -1,4 +1,4 @@
-#lang racket/base
+#lang honu/private
 
 (require (prefix-in racket: (combine-in racket/base racket/list)))
 
diff --git a/collects/honu/private/lang/reader.rkt b/collects/honu/private/lang/reader.rkt
new file mode 100644
index 0000000000..53b832e2c5
--- /dev/null
+++ b/collects/honu/private/lang/reader.rkt
@@ -0,0 +1,12 @@
+#lang s-exp syntax/module-reader
+
+honu/private/main
+
+;;#:read honu-read
+;;#:read-syntax honu-read-syntax
+;;#:whole-body-readers? #t
+#:language-info #(honu/core/language honu-language-info #f)
+; #:language-info #(honu/core/runtime configure 'dont-care)
+
+(require honu/core/read
+         honu/core/language)
diff --git a/collects/honu/private/main.rkt b/collects/honu/private/main.rkt
new file mode 100644
index 0000000000..8694e2e130
--- /dev/null
+++ b/collects/honu/private/main.rkt
@@ -0,0 +1,4 @@
+#lang racket/base
+
+(require racket/base)
+(provide (all-from-out racket/base))
diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt
index bf1973e3fe..5b01566eb2 100644
--- a/collects/lang/htdp-langs.rkt
+++ b/collects/lang/htdp-langs.rkt
@@ -591,7 +591,8 @@
                            (begin
                              (message-box (string-constant drscheme)
                                           (format (string-constant already-added-teachpack)
-                                                  (cadr teachpack)))
+                                                  (cadr teachpack))
+                                          #:dialog-mixin frame:focus-table-mixin)
                              settings)
                            
                            (let ([new-tps (append old-tps (list teachpack))])
@@ -686,7 +687,7 @@
                           tp-dirs))
         (define sort-order (λ (x y) (string<=? (path->string x) (path->string y))))
         (define pre-installed-tpss (map (λ (tps) (sort tps sort-order)) tpss))
-        (define dlg (new dialog% [parent parent] [label (string-constant drscheme)]))
+        (define dlg (new (frame:focus-table-mixin dialog%) [parent parent] [label (string-constant drscheme)]))
         (define hp (new horizontal-panel% [parent dlg]))
         (define answer #f)
         (define compiling? #f)
diff --git a/collects/lang/private/teach-module-begin.rkt b/collects/lang/private/teach-module-begin.rkt
index 2741142f3e..22addf011d 100644
--- a/collects/lang/private/teach-module-begin.rkt
+++ b/collects/lang/private/teach-module-begin.rkt
@@ -180,7 +180,7 @@
 		 ;; Lift out certain forms to make them visible to the module
 		 ;;  expander:
 		 (syntax-case e2 (#%require #%provide
-				  define-syntaxes define-values-for-syntax define-values begin
+				  define-syntaxes begin-for-syntax define-values begin
 				  define-signature :)
 		   ((#%require . __)
 		    #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
@@ -188,7 +188,7 @@
 		    #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
 		   ((define-syntaxes (id ...) . _)
 		    #`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids))))
-		   ((define-values-for-syntax . _)
+		   ((begin-for-syntax . _)
 		    #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
 		   ((begin b1 ...)
 		    (syntax-track-origin 
diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt
index 8763277f0a..79e6e2da38 100644
--- a/collects/lang/private/teach.rkt
+++ b/collects/lang/private/teach.rkt
@@ -1636,13 +1636,13 @@
 		  ;;  forms know that it's ok to expand in this internal
 		  ;;  definition context.
 		  [int-def-ctx (build-expand-context (make-expanding-for-intermediate-local))])
-	      (let* ([partly-expanded-defns 
-		      (map (lambda (d)
-			     (local-expand
-			      d
-			      int-def-ctx
-			      (kernel-form-identifier-list)))
-			   defns)]
+	      (let* ([partly-expand (lambda (d)
+                                      (local-expand
+                                       d
+                                       int-def-ctx
+                                       (kernel-form-identifier-list)))]
+                     [partly-expanded-defns
+		      (map partly-expand defns)]
 		     [flattened-defns
 		      (let loop ([l partly-expanded-defns][origs defns])
 			(apply
@@ -1653,7 +1653,7 @@
 				  ;; or `define-syntaxes', because only macros can generate
 				  ;; them
 				  [(begin defn ...)
-				   (let ([l (syntax->list (syntax (defn ...)))])
+				   (let ([l (map partly-expand (syntax->list (syntax (defn ...))))])
 				     (loop l l))]
 				  [(define-values . _)
 				   (list d)]
@@ -2145,9 +2145,7 @@
 	       (with-syntax ([x (loop (syntax x) (sub1 depth))]
 			     [rest (loop (syntax rest) depth)]
 			     [uq-splicing (stx-car (stx-car stx))])
-		 (stepper-syntax-property (syntax/loc stx (the-cons/matchable (list (quote uq-splicing) x) rest))
-                                  'stepper-hint
-                                  'quasiquote-the-cons-application)))]
+                 (syntax/loc stx (the-cons/matchable (list (quote uq-splicing) x) rest))))]
 	  [intermediate-unquote-splicing
 	   (teach-syntax-error
 	    'quasiquote
@@ -2161,9 +2159,7 @@
 	  [(a . b)
 	   (with-syntax ([a (loop (syntax a) depth)]
 			 [b (loop (syntax b) depth)])
-	     (stepper-syntax-property (syntax/loc stx (the-cons/matchable a b))
-                              'stepper-hint
-                              'quasiquote-the-cons-application))]
+             (syntax/loc stx (the-cons/matchable a b)))]
 	  [any
 	   (syntax/loc stx (quote any))])))
 
diff --git a/collects/macro-debugger/analysis/private/moduledb.rkt b/collects/macro-debugger/analysis/private/moduledb.rkt
index 6ce302e7af..a15d84ac64 100644
--- a/collects/macro-debugger/analysis/private/moduledb.rkt
+++ b/collects/macro-debugger/analysis/private/moduledb.rkt
@@ -21,7 +21,7 @@
      [racket/match                           no-bypass]
      ['#%builtin                             no-drop]
 
-     [typed-scheme/private/base-env          no-drop]
-     [typed-scheme/private/base-special-env  no-drop]
-     [typed-scheme/private/base-env-numeric  no-drop]
-     [typed-scheme/private/base-env-indexing no-drop])))
+     [typed-racket/private/base-env          no-drop]
+     [typed-racket/private/base-special-env  no-drop]
+     [typed-racket/private/base-env-numeric  no-drop]
+     [typed-racket/private/base-env-indexing no-drop])))
diff --git a/collects/macro-debugger/model/trace.rkt b/collects/macro-debugger/model/trace.rkt
index 527494b87d..db358c36a0 100644
--- a/collects/macro-debugger/model/trace.rkt
+++ b/collects/macro-debugger/model/trace.rkt
@@ -152,7 +152,7 @@
      (eval/compile stx)]
     [(define-syntaxes . _)
      (eval/compile stx)]
-    [(define-values-for-syntax . _)
+    [(begin-for-syntax . _)
      (eval/compile stx)]
     [(define-values (id ...) . _)
      (with-syntax ([defvals (stx-car stx)]
diff --git a/collects/meta/build/bundle b/collects/meta/build/bundle
index c7e080a1ea..5f6c5119fa 100755
--- a/collects/meta/build/bundle
+++ b/collects/meta/build/bundle
@@ -5,6 +5,7 @@
 
 (require racket/cmdline racket/runtime-path racket/match racket/promise
          racket/list ; for use in specs too
+         racket/string
          racket/file (only-in racket/system system)
          (except-in racket/mpair mappend)
          meta/checker (prefix-in dist: meta/dist-specs) meta/specs)
@@ -239,7 +240,13 @@
   (let* ([collects (or (tree-filter "/racket/collects/" (car trees))
                        (error 'make-info-domain "got no collects in tree"))]
          [info (filter (lambda (x)
-                         (let ([x (path->string (bytes->path (car x)))])
+                         (define p (car x))
+                         (unless (and (list? p)
+                                      ((length p) . >= . 2)
+                                      (eq? 'info (car p))
+                                      (andmap bytes? (cdr p)))
+                           (error 'bundle "unexpected path form in cache.rktd: ~e" p))
+                         (let ([x (string-join (map bytes->string/utf-8 (cdr p)) "/")])
                            (pair? (tree-filter (concat "/racket/collects/" x)
                                                collects))))
                        *info-domain-cache*)])
diff --git a/collects/meta/dist-specs.rkt b/collects/meta/dist-specs.rkt
index c52fced23a..556ba2ffd4 100644
--- a/collects/meta/dist-specs.rkt
+++ b/collects/meta/dist-specs.rkt
@@ -628,13 +628,14 @@ plt-extras :+= (collects: "texpict/")
 ;; -------------------- frtime
 plt-extras :+= (package: "frtime/")
 
-;; -------------------- typed-scheme
-dr-extras :+= (package: "typed-scheme/" ; used in drracket
+;; -------------------- typed-racket
+dr-extras :+= (package: "typed-racket/" ; used in drracket
                         #:docs "ts-{reference|guide}/")
               (- (collects: "typed/")
                  (cond (not plt) => (collects: "typed/test-engine/")
                                     (collects: "typed/rackunit/")
                                     (srcfile: "typed/rackunit.rkt")))
+              (collects: "typed-scheme") ; compatibility
 
 ;; -------------------- gui-debugger
 plt-extras :+= (collects: "gui-debugger/")
diff --git a/collects/meta/drdr/graph.rkt b/collects/meta/drdr/graph.rkt
deleted file mode 100644
index 333ee37fa2..0000000000
--- a/collects/meta/drdr/graph.rkt
+++ /dev/null
@@ -1,26 +0,0 @@
-#lang racket
-(require racket/system
-         "config.rkt"
-         "path-utils.rkt"
-         "dirstruct.rkt")
-
-(define rebaser
-  (rebase-path (plt-data-directory) "/data"))
-
-(define (main filename)
-  (define prefix
-    (path-timing-png-prefix filename))
-  (system*/exit-code
-   (path->string
-    (build-path (plt-directory) "plt" "bin" "gracket-text"))
-   "-t"
-   (path->string (build-path (drdr-directory) "graphs" "build-graph.rkt"))
-   "--"
-   "-l" (string-append "http://drdr.racket-lang.org/~a/" (path->string* filename)) ; XXX
-   "--image-loc" "/graph-images/"
-   (path->string (path-timing-log filename))
-   (path->string prefix)
-   (path->string (rebaser prefix))
-   (path->string (path-timing-html filename))))
-
-(provide main)
diff --git a/collects/meta/drdr/graphs/README b/collects/meta/drdr/graphs/README
deleted file mode 100644
index 4ff5b4648f..0000000000
--- a/collects/meta/drdr/graphs/README
+++ /dev/null
@@ -1,22 +0,0 @@
-- build the global .png files with a recent svn build:
-
-    gracket-text mk-img.rkt
-
-  This will dump some png files in the current directory. Put them in
-  some global place on the server
-
-- to build a script for a particular page, do this:
-
-   gracket-text build-graph.rkt -l http://drdr.racket-lang.org/~a/collects/path/to/file.scm \
-                            --image-loc /static/data/graph-images/  \
-                            file_scm.timing \
-                            file_scm_png_file_prefix \
-                            output.html
-
-   The -l flag is optional, without it clicking on the images won't go
-   anywhere; with it, clicking will go to the corresponding revision.
-   The --image-loc flag gives a url path to the directory containing
-   the images from the mk-img.rkt setp.  The other three args are the
-   timing data file, a prefix for the png files that generated for the
-   graphs, and the output html (which is a <div> ... </div>).
-
diff --git a/collects/meta/drdr/graphs/build-graph.rkt b/collects/meta/drdr/graphs/build-graph.rkt
deleted file mode 100644
index 8b44ec7d63..0000000000
--- a/collects/meta/drdr/graphs/build-graph.rkt
+++ /dev/null
@@ -1,690 +0,0 @@
-#lang racket/gui
-(require xml)
-
-(require "constants.rkt")
-
-;; example data:
-;; http://drdr.racket-lang.org/data/collects/tests/mzscheme/benchmarks/common/earley_ss.timing
-
-;;; ========================================
-
-;; a raw-line is
-;;  (list number number (listof (list number number number)))
-
-;; a graph is
-;;  (make-graph revision-number revision-number (listof line))
-(define-struct graph (start end lines) #:transparent)
-
-;; a line is
-;;  (make-line number number (listof point) string symbol)
-;;  style = (or/c 'overall 'cpu 'real 'gc)
-(define-struct line (min max points color style) #:transparent)
-
-;; value : number between [0,1] indicating the percentage
-;;         of the time of the slowest run
-;; revision : revision number
-(define-struct point (value revision) #:transparent)
-
-
-;; revision : nat
-;; x-pixel : nat
-(define-struct coordinate (revision x-pixel) #:transparent)
-
-(define graph-gap 4)
-(define max-revisions-per-graph (make-parameter 400))
-
-(define max-graphs-per-image (floor (/ graphs-width (+ graph-gap 4))))
-(define max-samples-per-image (floor (/ graphs-width 3)))
-
-(define link-format-string #f)
-
-(define image-loc "./")
-
-(define full? #f)
-
-(define-values (input-file image-filename-prefix image-url-prefix html-file)
-  (command-line
-#|
-   #:argv
-   #("-l"
-     "http://drdr.racket-lang.org/~a/collects/tests/mzscheme/benchmarks/mz/expand-class.scm"
-     "expand-class_scm.timing" "out" "out.html" )
-|#
-   #:once-each
-   [("-f" "--full")
-    "indicates that a complete html file should be produced; otherwise, a single div is all you get"
-    (set! full? #t)]
-   [("-l" "--link")
-    link-format
-    "specifies where revisions link to; expected to be a url with a ~a in the middle"
-    (set! link-format-string link-format)]
-   [("--image-loc")
-    url-path
-    "specify the path to the image files for html generation (not just to the dir; to the file itself)"
-    (unless (regexp-match #rx"/$" url-path)
-      (error 'build-graph.rkt "expected the image-loc to end with a /, got ~a" url-path))
-    (set! image-loc url-path)]
-   #:args (input-file image-filename-prefix image-url-prefix html-file) 
-   (values input-file image-filename-prefix image-url-prefix html-file)))
-
-(define dot-image-file (string-append image-loc "dot.png"))
-(define before-image-file (string-append image-loc "before.png"))
-(define after-image-file (string-append image-loc "after.png"))
-
-
-
-
-;                                              
-;                                              
-;                                              
-;                                              
-;                             ;;               
-;                             ;                
-;   ;;;;;  ;;;;;  ;;;; ;;;;   ;;  ;;;;;  ;;;;; 
-;   ;;;;;  ;; ;;  ;;;  ;; ;;  ;;  ;;;;;  ;;;;; 
-;   ;;  ;;   ;;;; ;;   ;;;;   ;;  ;; ;;;;;; ;; 
-;   ;;  ;; ;;;;;; ;;    ;;;;  ;;  ;; ;;;;;; ;; 
-;   ;;;;;;;;; ;;; ;;  ;;; ;;  ;;  ;; ;;; ;;;;; 
-;   ;;;;;  ;;;;;; ;;   ;;;;   ;;  ;; ;;; ;;;;; 
-;   ;;                                   ;; ;; 
-;   ;;                                   ;;;;; 
-;                                              
-;                                              
-
-;; orig-data : hash[revision-number -o> sexp]
-;; the original lines from the files, indexed by revision number
-(define orig-data (make-hash))
-
-(define (revision->duration revision)
-  (let ([info (hash-ref orig-data revision)])
-    (floor (inexact->exact (list-ref info 1)))))
-
-(define (revision->timings-array revision)
-  (let ([info (hash-ref orig-data revision)])
-    (apply
-     string-append
-     (append (list "[")
-             (add-between (map (λ (line)
-                                 (format "'cpu time: ~a real time: ~a gc time: ~a'"
-                                         (list-ref line 0)
-                                         (list-ref line 1)
-                                         (list-ref line 2)))
-                               (list-ref info 2))
-                          ",")
-             (list "]")))))
-
-;; this build ex2.rkt out of ex.rkt
-;; adjust : raw-line -> raw-line
-(define adjust
-  (let ([seen-time #f])
-    (lambda (l)
-      (match l
-        [`(,rev ,time ,times)
-         (cond
-           [(empty? times)
-            l]
-           [(not seen-time)
-            (set! seen-time 1)
-            l]
-           [(< seen-time 30)
-            (set! seen-time (+ seen-time 1))
-            l]
-           [else
-            (list (list-ref l 0)
-                  (list-ref l 1)
-                  (list (car (list-ref l 2))
-                        (map (λ (x) (* x 10)) (car (list-ref l 2)))))])]))))
-
-;; fetch-data : string -> (listof raw-line)[uniq revision-numbers]
-(define (fetch-data file)
-  (call-with-input-file file 
-    (λ (port)
-      (let loop ()
-        (let ([l (read port)])
-          (cond
-            [(eof-object? l) '()]
-            [(hash-ref orig-data (car l) #f)
-             ;; skip duplicate revisions
-             (loop)]
-            [else
-             (hash-set! orig-data (car l) l) 
-             (cons l (loop))]))))))
-
-;; build-graphss : (listof raw-line) -> (listof (listof graph))
-(define (build-graphss data)
-  (let ([large-graphs 
-         (filter
-          (λ (x) (<= 2 (length (line-points (car (graph-lines x))))))
-          (build-large-graphs data))])
-    (let loop ([graphs (reverse large-graphs)])
-       (let-values ([(first rest) (split-out-graph graphs)])
-         (cond
-           [(null? rest)
-            (list first)]
-           [else
-            (cons first (loop rest))])))))
-
-;; split-out-graphs : (listof graph) -> (values (listof graph) (listof graph))
-;; first result is a set of graphs to go into a single image
-;;   limits the number of graphs and the number of total samples
-;; expects the graphs to be in order from the right to the left 
-;;  returns the first result in the opposite order and the second result in the same order.
-(define (split-out-graph graphs)
-  (let loop ([graphs graphs]
-             [sample-count 0]
-             [graph-count 0]
-             [current '()])
-    (cond
-      [(null? graphs)
-       (values current graphs)]
-      [(< max-graphs-per-image graph-count)
-       (values current graphs)]
-      [else
-       (let* ([graph (car graphs)]
-              [this-graph-samples (graph-sample-count graph)])
-         (cond
-           [(<= (+ sample-count this-graph-samples) max-samples-per-image)
-            ;; if this graph fits, take it.
-            (loop (cdr graphs)
-                  (+ sample-count this-graph-samples)
-                  (+ graph-count 1)
-                  (cons graph current))]
-           [(<= sample-count (/ max-samples-per-image 2))
-            ;; if the graph doesn't fit, and we have less than 1/2 of the samples that fill 
-            ;; the page, break this graph into two graphs, taking the first part of the split
-            (let-values ([(before after) (split-graph 
-                                          graph
-                                          (- max-samples-per-image sample-count))])
-              (values (cons before current)
-                      (cons after (cdr graphs))))]
-           [else
-            ;; otherwise, just stop with what we have now
-            (values current
-                    graphs)]))])))
-
-;; split-graph : graph number -> (values graph graph)
-;; break graph into two pieces where the first piece has 'max-samples' samples
-;; split-point <= number of samples in graph
-(define (split-graph graph split-point)
-  (let* ([this-graph-samples (graph-sample-count graph)]
-         [orig-lines (graph-lines graph)]
-         [lines-before (pull-out orig-lines (λ (x) (take x split-point)))]
-         [lines-after (pull-out orig-lines (λ (x) (drop x split-point)))]
-         [lines-before-last-revision
-          (apply max (map point-revision (line-points (car lines-before))))]
-         [lines-after-first-revision
-          (apply min (map point-revision (line-points (car lines-after))))])
-    (values (make-graph (graph-start graph) 
-                        lines-before-last-revision
-                        lines-before)
-            (make-graph lines-after-first-revision 
-                        (graph-end graph)
-                        lines-after))))
-
-;; pull-out : (listof line) (-> (listof point) (listof point)) -> (listof line)
-;; makes lines like 'lines', but using puller to select the relevant points
-(define/contract (pull-out lines puller)
-  (-> (listof line?) (-> (listof point?) (listof point?)) (listof line?))
-  (map (λ (line)
-         (let* ([new-points (puller (line-points line))]
-                [max-v (apply max (map point-value new-points))]
-                [min-v (apply min (map point-value new-points))])
-           (make-line min-v
-                      max-v
-                      new-points
-                      (line-color line)
-                      (line-style line))))
-       lines))
-
-(define (graph-sample-count graph)
-  (length (line-points (car (graph-lines graph)))))
-
-;; build-large-graphs : (listof raw-line) -> (listof graph)
-(define (build-large-graphs data)
-  (let loop ([data data]
-             [working-graph '()])
-    (cond
-      [(null? data) 
-       (if (null? working-graph)
-           '()
-           (list (finalize-graph (reverse working-graph))))]
-      [else
-       (let ([this (car data)])
-         (cond
-           [(matching-line? this working-graph)
-            (loop (cdr data)
-                  (cons this working-graph))]
-           [else
-            (cons (finalize-graph (reverse working-graph))
-                  (loop data '()))]))])))
-
-;; matching-line? : raw-line (listof raw-line) -> boolean
-;; #t if the line fits into this graph
-(define (matching-line? line working-graph)
-  (or (null? working-graph)
-      (match line
-        [`(,rev ,time ,line-seqs)
-         (match (car working-graph)
-           [`(,rev ,time ,working-line-seq)
-            (= (length line-seqs)
-               (length working-line-seq))])])))
-
-;; split-up : (listof X) -> (listof (listof X))
-;; splits up the working graph into at chunks of size at most
-;; max-revisions-per-graph.
-(define (split-up working-graph)
-  (reverse
-   (let loop ([working-graph (reverse working-graph)]
-              [i 0]
-              [pending '()])
-     (cond
-       [(null? working-graph) 
-        (if (null? pending)
-            '()
-            (list pending))]
-       [else
-        (if (< i (max-revisions-per-graph))
-            (loop (cdr working-graph)
-                  (+ i 1)
-                  (cons (car working-graph) pending))
-            (cons pending
-                  (loop working-graph 0 '())))]))))
-
-;; poor man testing ....
-(parameterize ([max-revisions-per-graph 3])
-  (unless (and (equal? (split-up '()) '())
-               (equal? (split-up '(1)) '((1)))
-               (equal? (split-up '(1 2)) '((1 2)))
-               (equal? (split-up '(1 2 3)) '((1 2 3)))
-               (equal? (split-up '(1 2 3 4)) '((1) (2 3 4)))
-               (equal? (split-up '(1 2 3 4 5)) '((1 2) (3 4 5)))
-               (equal? (split-up '(1 2 3 4 5 6)) '((1 2 3) (4 5 6)))
-               (equal? (split-up '(1 2 3 4 5 6 7)) '((1) (2 3 4) (5 6 7))))
-    (error 'tests-failed)))
-
-;; finalize-graph : (non-empty-listof raw-line) -> graph
-(define (finalize-graph working-graph)
-  (restart-colors)
-  (let ([revisions (map first working-graph)])
-    (make-graph 
-     (car (car working-graph))
-     (car (last working-graph))
-     (cons
-      (build-line 'overall 
-                  (map second working-graph) 
-                  revisions
-                  "black")
-      (apply 
-       append
-       (let ([cpu-real-gcss (map third working-graph)])
-         (for/list ([ele (car cpu-real-gcss)]
-                    [i (in-naturals)])
-           (let ([color (next-color)])
-             (list (build-line 'cpu 
-                               (map (λ (x) (first (list-ref x i)))
-                                    cpu-real-gcss)
-                               revisions
-                               color)
-                   (build-line 'real 
-                               (map (λ (x) (second (list-ref x i))) 
-                                    cpu-real-gcss)
-                               revisions
-                               color)
-                   (build-line 'gc 
-                               (map (λ (x) (third (list-ref x i)))
-                                    cpu-real-gcss)
-                               revisions
-                               color))))))))))
-
-(define (build-line which points revisions color)
-  (let ([min-v (apply max points)]
-        [max-v (apply max points)])
-    (make-line min-v
-               max-v
-               (map make-point points revisions)
-               color which)))
-
-(define-values (next-color restart-colors)
-  (let ([colors '("darkred" 
-                  "mediumvioletred" 
-                  "brown"
-                  "midnightblue")]
-        [i 0])
-    (values (λ ()
-              (begin0
-                (list-ref colors i)
-                (set! i (modulo (+ i 1) (length colors)))))
-            (λ ()
-              (set! i 0)))))
-
-
-;                                                 
-;                                                 
-;                                                 
-;                                                 
-;      ;;                        ;;               
-;      ;;                        ;                
-;   ;;;;;  ;;;; ;;;;; ;;  ;;  ;; ;;  ;;;;;  ;;;;; 
-;   ;;;;;  ;;;  ;; ;;  ;  ;;  ;; ;;  ;;;;;  ;;;;; 
-;  ;;; ;;  ;;     ;;;; ;;;;;;;;  ;;  ;; ;;;;;; ;; 
-;  ;;; ;;  ;;   ;;;;;; ;;;;;;;;  ;;  ;; ;;;;;; ;; 
-;   ;;;;;  ;;  ;;; ;;;  ;;  ;;;  ;;  ;; ;;; ;;;;; 
-;   ;;;;;  ;;   ;;;;;;  ;;  ;;   ;;  ;; ;;; ;;;;; 
-;                                           ;; ;; 
-;                                           ;;;;; 
-;                                                 
-;
-
-
-;; record-points : (parameter (or/c #f (-> number[x-coordinate] number[revision] -> void)))
-(define record-points (make-parameter #f))
-
-(define (graphs->coordinates graphs)
-  (let ([dc (make-object bitmap-dc% (make-object bitmap% 1 1))]
-        [points (make-hash)])
-    (define (rp x-coord revision)
-      (let ([pixel (inexact->exact (floor x-coord))]
-            [prev (hash-ref points revision #f)])
-        (cond
-          [prev
-           (unless (equal? prev pixel)
-             (error 
-              'graphs->coordinates 
-              "revision ~s maps to two different pixel values! ~s and ~s" 
-              revision
-              prev
-              pixel))]
-          [else
-           (hash-set! points revision pixel)])))
-    (parameterize ([record-points rp])
-      (draw-graphs dc graphs))
-    (sort (hash-map points (λ (revision pixel) (make-coordinate revision pixel))) 
-          < 
-          #:key coordinate-revision)))
-
-(define (draw-graphs dc graphs)
-  (let ([tot-points (apply + (map graph-point-count graphs))]
-        [tot-space (- graphs-width (* graph-gap (- (length graphs) 1)))])
-    (let loop ([sx 0]
-               [graphs graphs])
-      (unless (null? graphs)
-        (let* ([graph (car graphs)]
-               [points (graph-point-count graph)]
-               [this-w (* (/ points tot-points) tot-space)]
-               [next-sx (+ sx this-w graph-gap)])
-          (draw-graph dc graph sx this-w)
-          (unless (null? (cdr graphs))
-            (send dc set-pen "black" 1 'transparent)
-            (send dc set-brush "gray" 'solid)
-            (send dc set-alpha 1)
-            (send dc draw-rectangle 
-                  (- next-sx graph-gap)
-                  0
-                  graph-gap
-                  graph-height))
-          (loop next-sx 
-                (cdr graphs)))))))
-
-(define (graph-point-count graph)
-  (length (line-points (car (graph-lines graph)))))
-
-(define (draw-graph dc graph sx w)
-  (draw-legend dc sx w)
-  (for ([line (in-list (graph-lines graph))])
-    (let* ([num-points (length (line-points line))]
-           [i->x (λ (i) (+ sx (* (/ i (- num-points 1)) w)))]
-           [point->y (λ (point) 
-                       (let ([lm (line-max line)])
-                         (if (zero? lm) ;; everything must be zero in this case
-                             graph-height
-                             (* (- 1 (/ (point-value point) lm)) 
-                                graph-height))))])
-      (send dc set-pen (line->pen line))
-      (send dc set-alpha (line->alpha line)) 
-      
-      (for ([start (in-list (line-points line))]
-            [end (in-list (cdr (line-points line)))]
-            [i (in-naturals)])
-        (let* ([x-start (i->x i)]
-               [x-end (i->x (+ i 1))]
-               [y-start (point->y start)]
-               [y-end (point->y end)])
-          (let ([rp (record-points)])
-            (when rp
-              (when (= i 0) (rp x-start (point-revision start)))
-              (rp x-end (point-revision end))))
-          (send dc draw-line 
-                x-start y-start
-                x-end y-end))))))
-
-(define (draw-legend dc sx w)
-  (send dc set-pen "gray" 3 'solid)
-  (send dc set-alpha 1)
-  (let ([hline (λ (p [dy 0])
-                 (send dc draw-line 
-                       sx
-                       (+ dy (* p graph-height))
-                       (+ sx w)
-                       (+ dy (* p graph-height))))])
-    (hline 0 1)
-    (hline 1/4)
-    (hline 1/2)
-    (hline 3/4)
-    (hline 1 -2)))
-
-(define (line->alpha line)
-  (case (line-style line)
-    [(overall) 1]
-    [(cpu) 1/2]
-    [(gc) 1/4]
-    [(real) 1]))
-
-(define (line->pen line)
-  (send the-pen-list find-or-create-pen 
-        (line-color line)
-        1
-        'solid))
-
-(define (draw fgs dc)
-  (send dc set-smoothing 'aligned)
-  (draw-graphs dc fgs))
-
-
-;                             
-;                             
-;                             
-;   ;;       ;             ;; 
-;   ;;      ;;             ;; 
-;   ;;      ;;             ;; 
-;   ;;;;;; ;;;; ;;;;;;;;;  ;; 
-;   ;;  ;;  ;;  ;; ;;; ;;; ;; 
-;   ;;  ;;  ;;  ;; ;;; ;;; ;; 
-;   ;;  ;;  ;;  ;; ;;; ;;; ;; 
-;   ;;  ;;  ;;  ;; ;;; ;;; ;; 
-;   ;; ;;;  ;;;;;; ;;; ;;; ;; 
-;                             
-;                             
-;                             
-
-(define (write-html graphss)
-  (let ([xml (xexpr->xml (graphs->complete-xexpr graphss))])
-    (call-with-output-file html-file
-      (λ (port) (display-xml/content xml port))
-      #:exists 'truncate)))
-
-(define (graphs->complete-xexpr graphss)
-  (let ([xexpr (graphs->xexpr graphss)])
-    (if full?
-        `(html (head)
-               (body ,xexpr))
-        xexpr)))
-       
-
-(define (graphs->xexpr graphss)
-  (let ([last-one (- (length graphss) 1)])
-    `(div
-      (script ((type "text/javascript"))
-              ,(format "var current_pane=~a;\n" last-one)
-              "function move_bar(rev,x,w,duration,timing_strings) {\n"
-              "  var suffix = ' msec'\n"
-              "  if (duration > 1000) {\n"
-              "    duration = duration/1000;"
-              "    suffix = ' sec'"
-              "  }\n"
-              "  document.getElementById(\"rev_and_duration\").innerHTML='revision '+rev+' duration '+duration+suffix;\n"
-              ,(make-cdata 
-                'here
-                'there
-                "  document.getElementById(\"timings\").innerHTML=timing_strings.join('<br />');\n")
-              "  var barimg = document.getElementById(\"barimg\");\n"
-              "  barimg.width=w;\n"
-              "  barimg.height=200;\n"
-              "  document.getElementById(\"bar\").style.left=x;\n"
-              ,@(if link-format-string
-                    (list (format
-                           "  document.getElementById(\"bara\").href='~a'+'?pane='+(current_pane+1)\n"
-                           (format link-format-string "'+rev+'")))
-                    '())
-              "  return true;\n"
-              "}\n"
-              "function do_before(){\n"
-              "  current_pane = current_pane-1;\n"
-              ,(format "  if (current_pane == -1) { current_pane=~a; }\n" last-one)
-              " update_pane();\n"
-              "}\n"
-              "function do_after(){\n"
-              "  current_pane = current_pane+1;\n"
-              ,(format "  if (current_pane == ~a) { current_pane=0; }\n" (+ 1 last-one))
-              " update_pane();\n"
-              "}\n"
-              "function update_pane(){\n"
-              "  var img = document.getElementById(\"img\");\n"
-              "  img.useMap='#revmap'+current_pane;\n"
-              ,(format "  img.src='~a'+current_pane+'.png';\n" image-url-prefix)
-              "  var p = current_pane+1;\n"
-              ,(format "  document.getElementById(\"paneid\").innerHTML=('Pane '+p+' of ~a');\n"
-                       (+ last-one 1))
-              "}\n"
-              "// this function from http://www.netlobo.com/url_query_string_javascript.html\n"
-              "function gup (name) {\n"
-              "  name = name.replace(/[\\[]/,\"\\\\\\[\").replace(/[\\]]/,\"\\\\\\]\");\n"
-              ,(make-cdata 'here 'there "  var regexS = \"[\\\\?&]\"+name+\"=([^&#]*)\";\n")
-              "  var regex = new RegExp( regexS );\n"
-              "  var results = regex.exec( window.location.href );\n"
-              "  if( results == null )\n"
-              "    return \"\";\n"
-              "  else\n"
-              "    return results[1];\n"
-              "}\n"
-              "function startup() {\n"
-              "  current_pane = parseInt(gup('pane'));\n"
-              "  if (isNaN(current_pane))\n"
-              ,(format "     current_pane = ~a;\n" last-one)
-              "  else\n"
-              ,(format "     current_pane = Math.min(Math.max(current_pane,1),~a)-1\n" (+ last-one 1))
-              "  update_pane();"
-              "}\n"
-              )
-      (table
-       ((cellpadding "0")
-        (cellspacing "0"))
-       (tr
-        (td (a ((href "#") (onclick "javascript:do_before(); return false;"))
-               (img ((border "0")
-                     (src ,before-image-file)))))
-        (td
-         (div ((style "position: relative;"))
-              (img ((src ,dot-image-file)
-                    (border "0")
-                    (id "img")
-                    (height ,(format "~a" graph-height))
-                    (width ,(format "~a" graphs-width))))
-              (div ((id "bar")
-                    (style "position: absolute; top: 0px; left: 20px"))
-                   (a ((id "bara"))
-                      (img ((style "border:none")
-                            (id "barimg")
-                            (width "0") 
-                            (height ,(format "~a" graph-height)) 
-                            (src ,dot-image-file)))))))
-        (td (a ((href "#") (onclick "javascript:do_after(); return false;")) 
-               (img ((border "0")
-                     (src ,after-image-file)))))))
-      (div (span ((id "paneid")) "")
-           (span ((id "rev_and_duration")) ""))
-      (tt (span ((id "timings")) ""))
-      
-      ,@(for/list ((graphs (in-list (reverse graphss)))
-                   (i (in-naturals)))
-          `(map ((name ,(format "revmap~a" i)))
-                ,@(graphs->areas graphs i)))
-      
-      (script ((type "text/javascript"))
-              "startup()"))))
-
-(define (graphs->areas graphs i)
-  (let ([coordinates (graphs->coordinates graphs)])
-    (for/list ([c-1 (cons #f coordinates)]
-               [c coordinates]
-               [c+1 (append (cdr coordinates) (list #f))])
-      (let ([left (if c-1
-                      (floor (average (coordinate-x-pixel c-1)
-                                      (coordinate-x-pixel c)))
-                      (coordinate-x-pixel c))]
-            [right (if c+1
-                       (floor (average (coordinate-x-pixel c) 
-                                       (coordinate-x-pixel c+1)))
-                       (coordinate-x-pixel c))])
-        `(area ((shape "rect")
-                (coords ,(format "~a,~a,~a,~a" left 0 right graph-height))
-                (onmouseover ,(format "move_bar('~a','~apx',~a,'~a',~a)" 
-                                      (coordinate-revision c)
-                                      left
-                                      (- right left)
-                                      (revision->duration (coordinate-revision c))
-                                      (revision->timings-array
-                                       (coordinate-revision c))))))))))
-
-(define (timing-strings c) (format "~s" c))
-
-(define (average . l) (/ (apply + l) (length l)))
-
-
-;; note: there is javascript code doing this same computation.
-(define (i->image-file i) (format "~a~a.png" image-filename-prefix i))
-
-
-;                               
-;                               
-;                               
-;                               
-;                     ;;        
-;                     ;         
-;   ;;;;; ;;   ;;;;;  ;;  ;;;;; 
-;   ;;;;;;;;;  ;; ;;  ;;  ;;;;; 
-;   ;; ;;  ;;    ;;;; ;;  ;; ;;;
-;   ;; ;;  ;;  ;;;;;; ;;  ;; ;;;
-;   ;; ;;  ;; ;;; ;;; ;;  ;; ;;;
-;   ;; ;;  ;;  ;;;;;; ;;  ;; ;;;
-;                               
-;                               
-;                               
-;
-
-(define (save fgs i)
-  (let* ([bm (make-object bitmap% graphs-width graph-height)]
-         [bdc (make-object bitmap-dc% bm)])
-    (send bdc clear)
-    (draw fgs bdc)
-    (send bdc set-bitmap #f)
-    (send bm save-file (i->image-file i) 'png)
-    (void)))
-
-(let ()
-  (define the-data (fetch-data input-file))
-  (define the-graphss (build-graphss the-data))
-
-  (write-html the-graphss)
-  (for ((the-graphs (in-list the-graphss))
-        (i (in-naturals)))
-    (save the-graphs i)))
diff --git a/collects/meta/drdr/graphs/constants.rkt b/collects/meta/drdr/graphs/constants.rkt
deleted file mode 100644
index ecb4d4aa5e..0000000000
--- a/collects/meta/drdr/graphs/constants.rkt
+++ /dev/null
@@ -1,7 +0,0 @@
-#lang racket/base
-(provide (all-defined-out))
-(define total-width 800)
-(define before-and-after-image-width 18)
-(define graph-height 200)
-(define graphs-width (- 800 (* 2 before-and-after-image-width)))
-
diff --git a/collects/meta/drdr/graphs/mk-img.rkt b/collects/meta/drdr/graphs/mk-img.rkt
deleted file mode 100644
index d5b212a807..0000000000
--- a/collects/meta/drdr/graphs/mk-img.rkt
+++ /dev/null
@@ -1,62 +0,0 @@
-#lang racket/gui
-
-(require 2htdp/image
-         "constants.rkt")
-
-;; make dot.png
-(let* ([bm (make-object bitmap% 1 1)]
-       [mask (make-object bitmap% 1 1)]
-       [bdc (make-object bitmap-dc% bm)])
-  (send bm set-loaded-mask mask)
-  (send bdc set-brush (make-object color% 50 100 20) 'solid)
-  (send bdc set-pen "black" 1 'transparent)
-  (send bdc draw-rectangle 0 0 1 1)
-  (send bdc set-bitmap mask)
-  (send bdc set-brush (make-object color% 100 100 100) 'solid)
-  (send bdc draw-rectangle 0 0 1 1)
-  (send bdc set-bitmap #f)
-  (send bm save-file "dot.png" 'png)
-  (void))
-
-(define (save-bitmap mask-image color filename)
-  (let* ([w (image-width mask-image)]
-         [h (image-height mask-image)]
-         [bm (make-object bitmap% w h)]
-         [mask (make-object bitmap% w h)]
-         [bdc (make-object bitmap-dc% bm)])
-
-    (unless (= w before-and-after-image-width)
-      (error 'mk-img.rkt "expected ~a image's width to be ~a, got ~a" 
-             filename
-             before-and-after-image-width
-             w))
-    
-    (send bm set-loaded-mask mask)
-    (send bdc set-brush color 'solid)
-    (send bdc set-pen "black" 1 'transparent)
-    (send bdc draw-rectangle 0 0 w h)
-    (send bdc set-bitmap mask)
-    (send bdc clear)
-    (send mask-image draw bdc 0 0 0 0 w h 0 0 'show-caret)
-    (send bdc set-bitmap #f)
-    (send bm save-file filename 'png)
-    (void)))
-  
-
-(define (space-out img x-place)
-  (overlay/align
-   x-place
-   'center
-   img
-   (rectangle (+ (image-width img) 4)
-              graph-height
-              'solid
-              'white)))
-
-(save-bitmap (space-out (rotate 90 (triangle 16 'solid 'black)) 'left)
-             "forestgreen"
-             "before.png")
-
-(save-bitmap (space-out (rotate -90 (triangle 16 'solid 'black)) 'right)
-             "forestgreen"
-             "after.png")
diff --git a/collects/meta/drdr/render.rkt b/collects/meta/drdr/render.rkt
index e274bd4daf..6a899a052a 100644
--- a/collects/meta/drdr/render.rkt
+++ b/collects/meta/drdr/render.rkt
@@ -282,6 +282,39 @@
       [(struct stderr (bs))
        `(pre ([class "stderr"]) ,(bytes->string/utf-8 bs))])))
 
+(define (json-out out x)
+  (cond
+   [(list? x)
+    (fprintf out "[")
+    (let loop ([l x])
+      (match l
+        [(list)
+         (void)]
+        [(list e)
+         (json-out out e)]
+        [(list-rest e es)
+         (json-out out e)
+         (fprintf out ",")
+         (loop es)]))
+    (fprintf out "]")]
+   [else
+    (display x out)]))
+          
+(define (json-timing req path-to-file)
+  (define timing-pth (path-timing-log (apply build-path path-to-file)))
+  (define ts (file->list timing-pth))
+  (response
+   200 #"Okay"
+   (file-or-directory-modify-seconds timing-pth)
+   #"application/json"
+   (list (make-header #"Access-Control-Allow-Origin"
+                      #"*"))
+   (lambda (out)
+     (fprintf out "[")
+     (for ([l (in-list (add-between ts ","))])
+          (json-out out l))         
+     (fprintf out "]"))))
+
 (define (render-log log-pth)
   (match (log-rendering log-pth)
     [#f
@@ -307,6 +340,9 @@
         (define output (map render-event output-log))
         (response/xexpr
          `(html (head (title ,title)
+                      (script ([language "javascript"] [type "text/javascript"] [src "/jquery-1.6.2.min.js"]) "")
+                      (script ([language "javascript"] [type "text/javascript"] [src "/jquery.flot.js"]) "")
+                      (script ([language "javascript"] [type "text/javascript"] [src "/jquery.flot.selection.js"]) "")
                       (link ([rel "stylesheet"] [type "text/css"] [href "/render.css"])))
                 (body 
                  (div ([class "log, content"])
@@ -337,23 +373,17 @@
                             '()
                             `((div ([class "output"]) " "
                                    ,@output)))
-                      ,(with-handlers ([exn:fail?
-                                        ; XXX Remove this eventually
-                                        (lambda (x)
-                                          ; XXX use dirstruct functions
-                                          (define png-path
-                                            (format "/data~a" (path-add-suffix (path-add-suffix the-base-path #".timing") #".png")))
-                                          `(div ([class "timing"])
-                                                (a ([href ,png-path])
-                                                   (img ([src ,png-path])))))])
-                         (make-cdata
-                          #f #f
-                          (local [(define content 
-                                    (file->string
-                                     (path-timing-html (substring (path->string* the-base-path) 1))))]
-                            #;(regexp-replace* #rx"&(?![a-z]+;)" content "\\&amp;\\1")
-                            (regexp-replace* #rx"&gt;" content ">"))
-                          ))
+
+                      (p)
+                      
+                      (div ([id "_chart"] [style "width:800px;height:300px;"]) "")
+                      (script ([language "javascript"] [type "text/javascript"] [src "/chart.js"]) "")
+                      (script ([language "javascript"] [type "text/javascript"])
+                              ,(format "get_data('~a');" the-base-path))
+                      (button ([onclick "reset_chart()"]) "Reset")
+                      (button ([id "setlegend"] [onclick "set_legend(!cur_options.legend.show)"])
+                              "Hide Legend")
+                      
                       ,(footer)))))])]))
 
 (define (number->string/zero v)
@@ -940,6 +970,7 @@
    [("help") show-help]
    [("") show-revisions]
    [("diff" (integer-arg) (integer-arg) (string-arg) ...) show-diff]
+   [("json" "timing" (string-arg) ...) json-timing]
    [("current" "") show-revision/current]
    [("current" (string-arg) ...) show-file/current]
    [((integer-arg) "") show-revision]
diff --git a/collects/meta/drdr/static/chart.js b/collects/meta/drdr/static/chart.js
new file mode 100644
index 0000000000..3235c208fa
--- /dev/null
+++ b/collects/meta/drdr/static/chart.js
@@ -0,0 +1,225 @@
+var path = ""
+var data = null;
+var sub_times = [];
+var overall_times = [];
+var chart_data = [];
+var show_hide = {}
+var options = { selection: { mode: "xy" },
+                legend: { backgroundOpacity: 0,
+                          position: "sw",
+                          show: true,
+                          noColumns : 1,
+                          labelFormatter :
+                          function(label, series) {
+                              if (show_hide[label] === undefined)
+                                  show_hide[label] = true;
+                              var css = '';
+                              if (!show_hide[label]) {
+                                  css = 'style="font-style: italic"';
+                              }
+                              var v = '<div '+css+' onclick="legend_click(\''+label+'\')">' + label + '</div>';
+                              return v;}},
+                xaxes: [{min: null, max: null, label: 'push'}],
+                yaxes: [{min: null, max: null, label: "time"},
+                        {position: "right"}],
+                grid: { clickable: true, hoverable : true }
+              };
+
+function legend_click(l) {
+    show_hide[l] = !show_hide[l];
+    show();
+    serialize_opts(options);
+}
+
+var placeholder = $("#_chart");
+var previousPoint = null;
+
+function showTooltip(x, y, contents) {
+    $('<div id="tooltip">' + contents + '</div>').css( {
+        position: 'absolute',
+        display: 'none',
+        top: y + 5,
+        left: x + 5,
+        border: '1px solid #fdd',
+        padding: '2px',
+        'background-color': '#fee',
+        opacity: 0.80
+    }).appendTo("body").fadeIn(200);
+}
+
+function makeTooltip(item,path) {
+    var x = item.datapoint[0];
+    var y = item.datapoint[1].toFixed(2);
+    showTooltip(item.pageX, item.pageY,
+                item.series.label + ' at <a href="http://drdr.racket-lang.org/'
+                + x + path + '">push ' + x + "</a>: "
+                + y + " ms");
+}
+placeholder.bind("plotselected", handle_selection);
+
+// is the tooltip shown b/c of a click?
+var tooltip_clicked = false;
+
+function remove_tooltip() {
+    tooltip_clicked = false;
+    $("#tooltip").remove();
+}
+
+function hover(event,pos,item) {
+    if (tooltip_clicked) return;
+    if (item) {
+        // don't re-show the same tool-tip that's already shown
+        if (previousPoint != item.dataIndex) {
+            previousPoint = item.dataIndex;
+            remove_tooltip();
+            makeTooltip(item,path);
+        }
+    }
+    else {
+        remove_tooltip();
+        previousPoint = null;
+    }
+}
+
+function click(e,pos,item) {
+    if (tooltip_clicked) {
+        remove_tooltip();
+        return;
+    }
+    if (!item) return;
+    tooltip_clicked = true;
+    // if we've already got the tooltip, just keep it around
+    if (previousPoint != item.dataIndex) {
+        $("#tooltip").remove();
+        makeTooltip(item,path);
+    }
+}
+
+
+function load_data(d) {
+    chart_data = [];
+    overall_times = [];
+    sub_times = [];
+    pdata = []
+    data = d;
+    reset_chart();
+    pdata = data && JSON.parse(data);
+
+    var max_overall = 0;
+    var max_sub = 0;
+
+    // build the timing data arrays
+    for (var i = 0; i < pdata.length; i++) {
+        overall_times.push([pdata[i][0], pdata[i][1]]);
+        max_overall = Math.max(max_overall, pdata[i][1]);
+        if (pdata[i][2].length != 0) {
+            for (var j = 0; j < pdata[i][2].length; j++) {
+                sub_times[j] = sub_times[j] || [];
+                sub_times[j].push([pdata[i][0],pdata[i][2][j][0]]);
+                max_sub = Math.max(max_sub, pdata[i][2][j][0]);
+            }
+        }
+    };
+
+    // is there a significant difference between the overall times
+    // and the internal timings?
+
+    var ya = 1;
+    if ((max_overall > (5 * max_sub)) || ((max_overall * 5) < max_sub))
+        ya = 2;
+
+    // put the data into the chart format
+    chart_data.push({data: overall_times, label: "Overall Time", color: "#804040"});
+    for(var i = 0; i < sub_times.length; i++) {
+        var n = (sub_times[i].length/overall_times.length);
+        chart_data.push({data: sub_times[i], label: "Timer "+ (i+1),
+                         lines: { show: (.9<n) },
+                         points: { show: !(.9<n) },
+                         yaxis: ya});
+    }
+    cur_options.legend.noColumns = Math.max(1,Math.round(chart_data.length / 10));
+}
+
+function get_data(_path) {
+    if (_path[0] != '/')
+        _path = '/' + _path;
+    path = _path;
+    $.ajax({url: 'http://drdr.racket-lang.org/json/timing'+path,
+            beforeSend: function(xhr) {
+                xhr.overrideMimeType( 'text/plain; charset=x-user-defined' );
+            },
+            success: function(d) { load_data(d); show(); }});
+}
+
+
+function show() {
+    for(var i = 0; i < chart_data.length; i++) {
+        if (show_hide[chart_data[i].label] === false) {
+            if (!chart_data[i].saved)
+                chart_data[i].saved = chart_data[i].data
+            chart_data[i].data = [];
+        }
+        else if (chart_data[i].data.length === 0 && chart_data[i].saved !== null) {
+            chart_data[i].data = chart_data[i].saved;
+            chart_data[i].saved = null;
+        }
+    }
+    $.plot(placeholder, chart_data, cur_options);
+}
+
+function serialize_opts(options) {
+    var o = {};
+    if (options.xaxes[0].min)
+        o.xmin = options.xaxes[0].min;
+    if (options.xaxes[0].max)
+        o.xmax = options.xaxes[0].max;
+    if (options.yaxes[0].min)
+        o.ymin = options.yaxes[0].min;
+    if (options.yaxes[0].max)
+        o.ymax = options.yaxes[0].max;
+    window.location.hash = "#" + (JSON.stringify([o,show_hide]));
+}
+
+function handle_selection(event, ranges) {
+    cur_options = $.extend(true, {}, cur_options, {
+        yaxes: [ { min: ranges.yaxis.from, max: ranges.yaxis.to },cur_options.yaxes[1]],
+        xaxes: [ { min: ranges.xaxis.from, max: ranges.xaxis.to } ]});
+    serialize_opts(cur_options);
+    show();
+
+}
+
+function set_legend(new_val) {
+  cur_options = $.extend(true,{},cur_options, {legend: {show: new_val}});
+  show();
+  if (new_val)
+      $("#setlegend").text("Hide Legend")
+  else
+      $("#setlegend").text("Show Legend")
+}
+
+function reset_chart() {
+    cur_options = options; show_hide = {}; show();
+}
+
+placeholder.bind("plothover", hover);
+placeholder.bind("plotclick", click);
+
+var opts = {xmin : null, ymin: null, xmax: null, ymax : null};
+
+var cur_options = options;
+
+try {
+    opts = JSON.parse(window.location.hash.substring(1));
+} catch(e) {}
+
+if (opts && opts.length == 2) {
+    cur_options.xaxes[0].min = opts[0].xmin;
+    cur_options.xaxes[0].max = opts[0].xmax;
+    cur_options.yaxes[0].min = opts[0].ymin;
+    cur_options.yaxes[0].max = opts[0].ymax;
+    for(i in opts[1]) {
+        console.log(i,opts[1][i]);
+        show_hide[i] = opts[1][i];
+    }
+}
diff --git a/collects/meta/drdr/static/jquery-1.6.2.min.js b/collects/meta/drdr/static/jquery-1.6.2.min.js
new file mode 100644
index 0000000000..48590ecb96
--- /dev/null
+++ b/collects/meta/drdr/static/jquery-1.6.2.min.js
@@ -0,0 +1,18 @@
+/*!
+ * jQuery JavaScript Library v1.6.2
+ * http://jquery.com/
+ *
+ * Copyright 2011, John Resig
+ * Dual licensed under the MIT or GPL Version 2 licenses.
+ * http://jquery.org/license
+ *
+ * Includes Sizzle.js
+ * http://sizzlejs.com/
+ * Copyright 2011, The Dojo Foundation
+ * Released under the MIT, BSD, and GPL Licenses.
+ *
+ * Date: Thu Jun 30 14:16:56 2011 -0400
+ */
+(function(a,b){function cv(a){return f.isWindow(a)?a:a.nodeType===9?a.defaultView||a.parentWindow:!1}function cs(a){if(!cg[a]){var b=c.body,d=f("<"+a+">").appendTo(b),e=d.css("display");d.remove();if(e==="none"||e===""){ch||(ch=c.createElement("iframe"),ch.frameBorder=ch.width=ch.height=0),b.appendChild(ch);if(!ci||!ch.createElement)ci=(ch.contentWindow||ch.contentDocument).document,ci.write((c.compatMode==="CSS1Compat"?"<!doctype html>":"")+"<html><body>"),ci.close();d=ci.createElement(a),ci.body.appendChild(d),e=f.css(d,"display"),b.removeChild(ch)}cg[a]=e}return cg[a]}function cr(a,b){var c={};f.each(cm.concat.apply([],cm.slice(0,b)),function(){c[this]=a});return c}function cq(){cn=b}function cp(){setTimeout(cq,0);return cn=f.now()}function cf(){try{return new a.ActiveXObject("Microsoft.XMLHTTP")}catch(b){}}function ce(){try{return new a.XMLHttpRequest}catch(b){}}function b$(a,c){a.dataFilter&&(c=a.dataFilter(c,a.dataType));var d=a.dataTypes,e={},g,h,i=d.length,j,k=d[0],l,m,n,o,p;for(g=1;g<i;g++){if(g===1)for(h in a.converters)typeof h=="string"&&(e[h.toLowerCase()]=a.converters[h]);l=k,k=d[g];if(k==="*")k=l;else if(l!=="*"&&l!==k){m=l+" "+k,n=e[m]||e["* "+k];if(!n){p=b;for(o in e){j=o.split(" ");if(j[0]===l||j[0]==="*"){p=e[j[1]+" "+k];if(p){o=e[o],o===!0?n=p:p===!0&&(n=o);break}}}}!n&&!p&&f.error("No conversion from "+m.replace(" "," to ")),n!==!0&&(c=n?n(c):p(o(c)))}}return c}function bZ(a,c,d){var e=a.contents,f=a.dataTypes,g=a.responseFields,h,i,j,k;for(i in g)i in d&&(c[g[i]]=d[i]);while(f[0]==="*")f.shift(),h===b&&(h=a.mimeType||c.getResponseHeader("content-type"));if(h)for(i in e)if(e[i]&&e[i].test(h)){f.unshift(i);break}if(f[0]in d)j=f[0];else{for(i in d){if(!f[0]||a.converters[i+" "+f[0]]){j=i;break}k||(k=i)}j=j||k}if(j){j!==f[0]&&f.unshift(j);return d[j]}}function bY(a,b,c,d){if(f.isArray(b))f.each(b,function(b,e){c||bC.test(a)?d(a,e):bY(a+"["+(typeof e=="object"||f.isArray(e)?b:"")+"]",e,c,d)});else if(!c&&b!=null&&typeof b=="object")for(var e in b)bY(a+"["+e+"]",b[e],c,d);else d(a,b)}function bX(a,c,d,e,f,g){f=f||c.dataTypes[0],g=g||{},g[f]=!0;var h=a[f],i=0,j=h?h.length:0,k=a===bR,l;for(;i<j&&(k||!l);i++)l=h[i](c,d,e),typeof l=="string"&&(!k||g[l]?l=b:(c.dataTypes.unshift(l),l=bX(a,c,d,e,l,g)));(k||!l)&&!g["*"]&&(l=bX(a,c,d,e,"*",g));return l}function bW(a){return function(b,c){typeof b!="string"&&(c=b,b="*");if(f.isFunction(c)){var d=b.toLowerCase().split(bN),e=0,g=d.length,h,i,j;for(;e<g;e++)h=d[e],j=/^\+/.test(h),j&&(h=h.substr(1)||"*"),i=a[h]=a[h]||[],i[j?"unshift":"push"](c)}}}function bA(a,b,c){var d=b==="width"?a.offsetWidth:a.offsetHeight,e=b==="width"?bv:bw;if(d>0){c!=="border"&&f.each(e,function(){c||(d-=parseFloat(f.css(a,"padding"+this))||0),c==="margin"?d+=parseFloat(f.css(a,c+this))||0:d-=parseFloat(f.css(a,"border"+this+"Width"))||0});return d+"px"}d=bx(a,b,b);if(d<0||d==null)d=a.style[b]||0;d=parseFloat(d)||0,c&&f.each(e,function(){d+=parseFloat(f.css(a,"padding"+this))||0,c!=="padding"&&(d+=parseFloat(f.css(a,"border"+this+"Width"))||0),c==="margin"&&(d+=parseFloat(f.css(a,c+this))||0)});return d+"px"}function bm(a,b){b.src?f.ajax({url:b.src,async:!1,dataType:"script"}):f.globalEval((b.text||b.textContent||b.innerHTML||"").replace(be,"/*$0*/")),b.parentNode&&b.parentNode.removeChild(b)}function bl(a){f.nodeName(a,"input")?bk(a):"getElementsByTagName"in a&&f.grep(a.getElementsByTagName("input"),bk)}function bk(a){if(a.type==="checkbox"||a.type==="radio")a.defaultChecked=a.checked}function bj(a){return"getElementsByTagName"in a?a.getElementsByTagName("*"):"querySelectorAll"in a?a.querySelectorAll("*"):[]}function bi(a,b){var c;if(b.nodeType===1){b.clearAttributes&&b.clearAttributes(),b.mergeAttributes&&b.mergeAttributes(a),c=b.nodeName.toLowerCase();if(c==="object")b.outerHTML=a.outerHTML;else if(c!=="input"||a.type!=="checkbox"&&a.type!=="radio"){if(c==="option")b.selected=a.defaultSelected;else if(c==="input"||c==="textarea")b.defaultValue=a.defaultValue}else a.checked&&(b.defaultChecked=b.checked=a.checked),b.value!==a.value&&(b.value=a.value);b.removeAttribute(f.expando)}}function bh(a,b){if(b.nodeType===1&&!!f.hasData(a)){var c=f.expando,d=f.data(a),e=f.data(b,d);if(d=d[c]){var g=d.events;e=e[c]=f.extend({},d);if(g){delete e.handle,e.events={};for(var h in g)for(var i=0,j=g[h].length;i<j;i++)f.event.add(b,h+(g[h][i].namespace?".":"")+g[h][i].namespace,g[h][i],g[h][i].data)}}}}function bg(a,b){return f.nodeName(a,"table")?a.getElementsByTagName("tbody")[0]||a.appendChild(a.ownerDocument.createElement("tbody")):a}function W(a,b,c){b=b||0;if(f.isFunction(b))return f.grep(a,function(a,d){var e=!!b.call(a,d,a);return e===c});if(b.nodeType)return f.grep(a,function(a,d){return a===b===c});if(typeof b=="string"){var d=f.grep(a,function(a){return a.nodeType===1});if(R.test(b))return f.filter(b,d,!c);b=f.filter(b,d)}return f.grep(a,function(a,d){return f.inArray(a,b)>=0===c})}function V(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function N(a,b){return(a&&a!=="*"?a+".":"")+b.replace(z,"`").replace(A,"&")}function M(a){var b,c,d,e,g,h,i,j,k,l,m,n,o,p=[],q=[],r=f._data(this,"events");if(!(a.liveFired===this||!r||!r.live||a.target.disabled||a.button&&a.type==="click")){a.namespace&&(n=new RegExp("(^|\\.)"+a.namespace.split(".").join("\\.(?:.*\\.)?")+"(\\.|$)")),a.liveFired=this;var s=r.live.slice(0);for(i=0;i<s.length;i++)g=s[i],g.origType.replace(x,"")===a.type?q.push(g.selector):s.splice(i--,1);e=f(a.target).closest(q,a.currentTarget);for(j=0,k=e.length;j<k;j++){m=e[j];for(i=0;i<s.length;i++){g=s[i];if(m.selector===g.selector&&(!n||n.test(g.namespace))&&!m.elem.disabled){h=m.elem,d=null;if(g.preType==="mouseenter"||g.preType==="mouseleave")a.type=g.preType,d=f(a.relatedTarget).closest(g.selector)[0],d&&f.contains(h,d)&&(d=h);(!d||d!==h)&&p.push({elem:h,handleObj:g,level:m.level})}}}for(j=0,k=p.length;j<k;j++){e=p[j];if(c&&e.level>c)break;a.currentTarget=e.elem,a.data=e.handleObj.data,a.handleObj=e.handleObj,o=e.handleObj.origHandler.apply(e.elem,arguments);if(o===!1||a.isPropagationStopped()){c=e.level,o===!1&&(b=!1);if(a.isImmediatePropagationStopped())break}}return b}}function K(a,c,d){var e=f.extend({},d[0]);e.type=a,e.originalEvent={},e.liveFired=b,f.event.handle.call(c,e),e.isDefaultPrevented()&&d[0].preventDefault()}function E(){return!0}function D(){return!1}function m(a,c,d){var e=c+"defer",g=c+"queue",h=c+"mark",i=f.data(a,e,b,!0);i&&(d==="queue"||!f.data(a,g,b,!0))&&(d==="mark"||!f.data(a,h,b,!0))&&setTimeout(function(){!f.data(a,g,b,!0)&&!f.data(a,h,b,!0)&&(f.removeData(a,e,!0),i.resolve())},0)}function l(a){for(var b in a)if(b!=="toJSON")return!1;return!0}function k(a,c,d){if(d===b&&a.nodeType===1){var e="data-"+c.replace(j,"$1-$2").toLowerCase();d=a.getAttribute(e);if(typeof d=="string"){try{d=d==="true"?!0:d==="false"?!1:d==="null"?null:f.isNaN(d)?i.test(d)?f.parseJSON(d):d:parseFloat(d)}catch(g){}f.data(a,c,d)}else d=b}return d}var c=a.document,d=a.navigator,e=a.location,f=function(){function J(){if(!e.isReady){try{c.documentElement.doScroll("left")}catch(a){setTimeout(J,1);return}e.ready()}}var e=function(a,b){return new e.fn.init(a,b,h)},f=a.jQuery,g=a.$,h,i=/^(?:[^<]*(<[\w\W]+>)[^>]*$|#([\w\-]*)$)/,j=/\S/,k=/^\s+/,l=/\s+$/,m=/\d/,n=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,o=/^[\],:{}\s]*$/,p=/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,q=/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,r=/(?:^|:|,)(?:\s*\[)+/g,s=/(webkit)[ \/]([\w.]+)/,t=/(opera)(?:.*version)?[ \/]([\w.]+)/,u=/(msie) ([\w.]+)/,v=/(mozilla)(?:.*? rv:([\w.]+))?/,w=/-([a-z])/ig,x=function(a,b){return b.toUpperCase()},y=d.userAgent,z,A,B,C=Object.prototype.toString,D=Object.prototype.hasOwnProperty,E=Array.prototype.push,F=Array.prototype.slice,G=String.prototype.trim,H=Array.prototype.indexOf,I={};e.fn=e.prototype={constructor:e,init:function(a,d,f){var g,h,j,k;if(!a)return this;if(a.nodeType){this.context=this[0]=a,this.length=1;return this}if(a==="body"&&!d&&c.body){this.context=c,this[0]=c.body,this.selector=a,this.length=1;return this}if(typeof a=="string"){a.charAt(0)!=="<"||a.charAt(a.length-1)!==">"||a.length<3?g=i.exec(a):g=[null,a,null];if(g&&(g[1]||!d)){if(g[1]){d=d instanceof e?d[0]:d,k=d?d.ownerDocument||d:c,j=n.exec(a),j?e.isPlainObject(d)?(a=[c.createElement(j[1])],e.fn.attr.call(a,d,!0)):a=[k.createElement(j[1])]:(j=e.buildFragment([g[1]],[k]),a=(j.cacheable?e.clone(j.fragment):j.fragment).childNodes);return e.merge(this,a)}h=c.getElementById(g[2]);if(h&&h.parentNode){if(h.id!==g[2])return f.find(a);this.length=1,this[0]=h}this.context=c,this.selector=a;return this}return!d||d.jquery?(d||f).find(a):this.constructor(d).find(a)}if(e.isFunction(a))return f.ready(a);a.selector!==b&&(this.selector=a.selector,this.context=a.context);return e.makeArray(a,this)},selector:"",jquery:"1.6.2",length:0,size:function(){return this.length},toArray:function(){return F.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this[this.length+a]:this[a]},pushStack:function(a,b,c){var d=this.constructor();e.isArray(a)?E.apply(d,a):e.merge(d,a),d.prevObject=this,d.context=this.context,b==="find"?d.selector=this.selector+(this.selector?" ":"")+c:b&&(d.selector=this.selector+"."+b+"("+c+")");return d},each:function(a,b){return e.each(this,a,b)},ready:function(a){e.bindReady(),A.done(a);return this},eq:function(a){return a===-1?this.slice(a):this.slice(a,+a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(F.apply(this,arguments),"slice",F.call(arguments).join(","))},map:function(a){return this.pushStack(e.map(this,function(b,c){return a.call(b,c,b)}))},end:function(){return this.prevObject||this.constructor(null)},push:E,sort:[].sort,splice:[].splice},e.fn.init.prototype=e.fn,e.extend=e.fn.extend=function(){var a,c,d,f,g,h,i=arguments[0]||{},j=1,k=arguments.length,l=!1;typeof i=="boolean"&&(l=i,i=arguments[1]||{},j=2),typeof i!="object"&&!e.isFunction(i)&&(i={}),k===j&&(i=this,--j);for(;j<k;j++)if((a=arguments[j])!=null)for(c in a){d=i[c],f=a[c];if(i===f)continue;l&&f&&(e.isPlainObject(f)||(g=e.isArray(f)))?(g?(g=!1,h=d&&e.isArray(d)?d:[]):h=d&&e.isPlainObject(d)?d:{},i[c]=e.extend(l,h,f)):f!==b&&(i[c]=f)}return i},e.extend({noConflict:function(b){a.$===e&&(a.$=g),b&&a.jQuery===e&&(a.jQuery=f);return e},isReady:!1,readyWait:1,holdReady:function(a){a?e.readyWait++:e.ready(!0)},ready:function(a){if(a===!0&&!--e.readyWait||a!==!0&&!e.isReady){if(!c.body)return setTimeout(e.ready,1);e.isReady=!0;if(a!==!0&&--e.readyWait>0)return;A.resolveWith(c,[e]),e.fn.trigger&&e(c).trigger("ready").unbind("ready")}},bindReady:function(){if(!A){A=e._Deferred();if(c.readyState==="complete")return setTimeout(e.ready,1);if(c.addEventListener)c.addEventListener("DOMContentLoaded",B,!1),a.addEventListener("load",e.ready,!1);else if(c.attachEvent){c.attachEvent("onreadystatechange",B),a.attachEvent("onload",e.ready);var b=!1;try{b=a.frameElement==null}catch(d){}c.documentElement.doScroll&&b&&J()}}},isFunction:function(a){return e.type(a)==="function"},isArray:Array.isArray||function(a){return e.type(a)==="array"},isWindow:function(a){return a&&typeof a=="object"&&"setInterval"in a},isNaN:function(a){return a==null||!m.test(a)||isNaN(a)},type:function(a){return a==null?String(a):I[C.call(a)]||"object"},isPlainObject:function(a){if(!a||e.type(a)!=="object"||a.nodeType||e.isWindow(a))return!1;if(a.constructor&&!D.call(a,"constructor")&&!D.call(a.constructor.prototype,"isPrototypeOf"))return!1;var c;for(c in a);return c===b||D.call(a,c)},isEmptyObject:function(a){for(var b in a)return!1;return!0},error:function(a){throw a},parseJSON:function(b){if(typeof b!="string"||!b)return null;b=e.trim(b);if(a.JSON&&a.JSON.parse)return a.JSON.parse(b);if(o.test(b.replace(p,"@").replace(q,"]").replace(r,"")))return(new Function("return "+b))();e.error("Invalid JSON: "+b)},parseXML:function(b,c,d){a.DOMParser?(d=new DOMParser,c=d.parseFromString(b,"text/xml")):(c=new ActiveXObject("Microsoft.XMLDOM"),c.async="false",c.loadXML(b)),d=c.documentElement,(!d||!d.nodeName||d.nodeName==="parsererror")&&e.error("Invalid XML: "+b);return c},noop:function(){},globalEval:function(b){b&&j.test(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(w,x)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,c,d){var f,g=0,h=a.length,i=h===b||e.isFunction(a);if(d){if(i){for(f in a)if(c.apply(a[f],d)===!1)break}else for(;g<h;)if(c.apply(a[g++],d)===!1)break}else if(i){for(f in a)if(c.call(a[f],f,a[f])===!1)break}else for(;g<h;)if(c.call(a[g],g,a[g++])===!1)break;return a},trim:G?function(a){return a==null?"":G.call(a)}:function(a){return a==null?"":(a+"").replace(k,"").replace(l,"")},makeArray:function(a,b){var c=b||[];if(a!=null){var d=e.type(a);a.length==null||d==="string"||d==="function"||d==="regexp"||e.isWindow(a)?E.call(c,a):e.merge(c,a)}return c},inArray:function(a,b){if(H)return H.call(b,a);for(var c=0,d=b.length;c<d;c++)if(b[c]===a)return c;return-1},merge:function(a,c){var d=a.length,e=0;if(typeof c.length=="number")for(var f=c.length;e<f;e++)a[d++]=c[e];else while(c[e]!==b)a[d++]=c[e++];a.length=d;return a},grep:function(a,b,c){var d=[],e;c=!!c;for(var f=0,g=a.length;f<g;f++)e=!!b(a[f],f),c!==e&&d.push(a[f]);return d},map:function(a,c,d){var f,g,h=[],i=0,j=a.length,k=a instanceof e||j!==b&&typeof j=="number"&&(j>0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i<j;i++)f=c(a[i],i,d),f!=null&&(h[h.length]=f);else for(g in a)f=c(a[g],g,d),f!=null&&(h[h.length]=f);return h.concat.apply([],h)},guid:1,proxy:function(a,c){if(typeof c=="string"){var d=a[c];c=a,a=d}if(!e.isFunction(a))return b;var f=F.call(arguments,2),g=function(){return a.apply(c,f.concat(F.call(arguments)))};g.guid=a.guid=a.guid||g.guid||e.guid++;return g},access:function(a,c,d,f,g,h){var i=a.length;if(typeof c=="object"){for(var j in c)e.access(a,j,c[j],f,g,d);return a}if(d!==b){f=!h&&f&&e.isFunction(d);for(var k=0;k<i;k++)g(a[k],c,f?d.call(a[k],k,g(a[k],c)):d,h);return a}return i?g(a[0],c):b},now:function(){return(new Date).getTime()},uaMatch:function(a){a=a.toLowerCase();var b=s.exec(a)||t.exec(a)||u.exec(a)||a.indexOf("compatible")<0&&v.exec(a)||[];return{browser:b[1]||"",version:b[2]||"0"}},sub:function(){function a(b,c){return new a.fn.init(b,c)}e.extend(!0,a,this),a.superclass=this,a.fn=a.prototype=this(),a.fn.constructor=a,a.sub=this.sub,a.fn.init=function(d,f){f&&f instanceof e&&!(f instanceof a)&&(f=a(f));return e.fn.init.call(this,d,f,b)},a.fn.init.prototype=a.fn;var b=a(c);return a},browser:{}}),e.each("Boolean Number String Function Array Date RegExp Object".split(" "),function(a,b){I["[object "+b+"]"]=b.toLowerCase()}),z=e.uaMatch(y),z.browser&&(e.browser[z.browser]=!0,e.browser.version=z.version),e.browser.webkit&&(e.browser.safari=!0),j.test(" ")&&(k=/^[\s\xA0]+/,l=/[\s\xA0]+$/),h=e(c),c.addEventListener?B=function(){c.removeEventListener("DOMContentLoaded",B,!1),e.ready()}:c.attachEvent&&(B=function(){c.readyState==="complete"&&(c.detachEvent("onreadystatechange",B),e.ready())});return e}(),g="done fail isResolved isRejected promise then always pipe".split(" "),h=[].slice;f.extend({_Deferred:function(){var a=[],b,c,d,e={done:function(){if(!d){var c=arguments,g,h,i,j,k;b&&(k=b,b=0);for(g=0,h=c.length;g<h;g++)i=c[g],j=f.type(i),j==="array"?e.done.apply(e,i):j==="function"&&a.push(i);k&&e.resolveWith(k[0],k[1])}return this},resolveWith:function(e,f){if(!d&&!b&&!c){f=f||[],c=1;try{while(a[0])a.shift().apply(e,f)}finally{b=[e,f],c=0}}return this},resolve:function(){e.resolveWith(this,arguments);return this},isResolved:function(){return!!c||!!b},cancel:function(){d=1,a=[];return this}};return e},Deferred:function(a){var b=f._Deferred(),c=f._Deferred(),d;f.extend(b,{then:function(a,c){b.done(a).fail(c);return this},always:function(){return b.done.apply(b,arguments).fail.apply(this,arguments)},fail:c.done,rejectWith:c.resolveWith,reject:c.resolve,isRejected:c.isResolved,pipe:function(a,c){return f.Deferred(function(d){f.each({done:[a,"resolve"],fail:[c,"reject"]},function(a,c){var e=c[0],g=c[1],h;f.isFunction(e)?b[a](function(){h=e.apply(this,arguments),h&&f.isFunction(h.promise)?h.promise().then(d.resolve,d.reject):d[g](h)}):b[a](d[g])})}).promise()},promise:function(a){if(a==null){if(d)return d;d=a={}}var c=g.length;while(c--)a[g[c]]=b[g[c]];return a}}),b.done(c.cancel).fail(b.cancel),delete b.cancel,a&&a.call(b,b);return b},when:function(a){function i(a){return function(c){b[a]=arguments.length>1?h.call(arguments,0):c,--e||g.resolveWith(g,h.call(b,0))}}var b=arguments,c=0,d=b.length,e=d,g=d<=1&&a&&f.isFunction(a.promise)?a:f.Deferred();if(d>1){for(;c<d;c++)b[c]&&f.isFunction(b[c].promise)?b[c].promise().then(i(c),g.reject):--e;e||g.resolveWith(g,b)}else g!==a&&g.resolveWith(g,d?[a]:[]);return g.promise()}}),f.support=function(){var a=c.createElement("div"),b=c.documentElement,d,e,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u;a.setAttribute("className","t"),a.innerHTML="   <link/><table></table><a href='/a' style='top:1px;float:left;opacity:.55;'>a</a><input type='checkbox'/>",d=a.getElementsByTagName("*"),e=a.getElementsByTagName("a")[0];if(!d||!d.length||!e)return{};g=c.createElement("select"),h=g.appendChild(c.createElement("option")),i=a.getElementsByTagName("input")[0],k={leadingWhitespace:a.firstChild.nodeType===3,tbody:!a.getElementsByTagName("tbody").length,htmlSerialize:!!a.getElementsByTagName("link").length,style:/top/.test(e.getAttribute("style")),hrefNormalized:e.getAttribute("href")==="/a",opacity:/^0.55$/.test(e.style.opacity),cssFloat:!!e.style.cssFloat,checkOn:i.value==="on",optSelected:h.selected,getSetAttribute:a.className!=="t",submitBubbles:!0,changeBubbles:!0,focusinBubbles:!1,deleteExpando:!0,noCloneEvent:!0,inlineBlockNeedsLayout:!1,shrinkWrapBlocks:!1,reliableMarginRight:!0},i.checked=!0,k.noCloneChecked=i.cloneNode(!0).checked,g.disabled=!0,k.optDisabled=!h.disabled;try{delete a.test}catch(v){k.deleteExpando=!1}!a.addEventListener&&a.attachEvent&&a.fireEvent&&(a.attachEvent("onclick",function(){k.noCloneEvent=!1}),a.cloneNode(!0).fireEvent("onclick")),i=c.createElement("input"),i.value="t",i.setAttribute("type","radio"),k.radioValue=i.value==="t",i.setAttribute("checked","checked"),a.appendChild(i),l=c.createDocumentFragment(),l.appendChild(a.firstChild),k.checkClone=l.cloneNode(!0).cloneNode(!0).lastChild.checked,a.innerHTML="",a.style.width=a.style.paddingLeft="1px",m=c.getElementsByTagName("body")[0],o=c.createElement(m?"div":"body"),p={visibility:"hidden",width:0,height:0,border:0,margin:0},m&&f.extend(p,{position:"absolute",left:-1e3,top:-1e3});for(t in p)o.style[t]=p[t];o.appendChild(a),n=m||b,n.insertBefore(o,n.firstChild),k.appendChecked=i.checked,k.boxModel=a.offsetWidth===2,"zoom"in a.style&&(a.style.display="inline",a.style.zoom=1,k.inlineBlockNeedsLayout=a.offsetWidth===2,a.style.display="",a.innerHTML="<div style='width:4px;'></div>",k.shrinkWrapBlocks=a.offsetWidth!==2),a.innerHTML="<table><tr><td style='padding:0;border:0;display:none'></td><td>t</td></tr></table>",q=a.getElementsByTagName("td"),u=q[0].offsetHeight===0,q[0].style.display="",q[1].style.display="none",k.reliableHiddenOffsets=u&&q[0].offsetHeight===0,a.innerHTML="",c.defaultView&&c.defaultView.getComputedStyle&&(j=c.createElement("div"),j.style.width="0",j.style.marginRight="0",a.appendChild(j),k.reliableMarginRight=(parseInt((c.defaultView.getComputedStyle(j,null)||{marginRight:0}).marginRight,10)||0)===0),o.innerHTML="",n.removeChild(o);if(a.attachEvent)for(t in{submit:1,change:1,focusin:1})s="on"+t,u=s in a,u||(a.setAttribute(s,"return;"),u=typeof a[s]=="function"),k[t+"Bubbles"]=u;o=l=g=h=m=j=a=i=null;return k}(),f.boxModel=f.support.boxModel;var i=/^(?:\{.*\}|\[.*\])$/,j=/([a-z])([A-Z])/g;f.extend({cache:{},uuid:0,expando:"jQuery"+(f.fn.jquery+Math.random()).replace(/\D/g,""),noData:{embed:!0,object:"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000",applet:!0},hasData:function(a){a=a.nodeType?f.cache[a[f.expando]]:a[f.expando];return!!a&&!l(a)},data:function(a,c,d,e){if(!!f.acceptData(a)){var g=f.expando,h=typeof c=="string",i,j=a.nodeType,k=j?f.cache:a,l=j?a[f.expando]:a[f.expando]&&f.expando;if((!l||e&&l&&!k[l][g])&&h&&d===b)return;l||(j?a[f.expando]=l=++f.uuid:l=f.expando),k[l]||(k[l]={},j||(k[l].toJSON=f.noop));if(typeof c=="object"||typeof c=="function")e?k[l][g]=f.extend(k[l][g],c):k[l]=f.extend(k[l],c);i=k[l],e&&(i[g]||(i[g]={}),i=i[g]),d!==b&&(i[f.camelCase(c)]=d);if(c==="events"&&!i[c])return i[g]&&i[g].events;return h?i[f.camelCase(c)]||i[c]:i}},removeData:function(b,c,d){if(!!f.acceptData(b)){var e=f.expando,g=b.nodeType,h=g?f.cache:b,i=g?b[f.expando]:f.expando;if(!h[i])return;if(c){var j=d?h[i][e]:h[i];if(j){delete j[c];if(!l(j))return}}if(d){delete h[i][e];if(!l(h[i]))return}var k=h[i][e];f.support.deleteExpando||h!=a?delete h[i]:h[i]=null,k?(h[i]={},g||(h[i].toJSON=f.noop),h[i][e]=k):g&&(f.support.deleteExpando?delete b[f.expando]:b.removeAttribute?b.removeAttribute(f.expando):b[f.expando]=null)}},_data:function(a,b,c){return f.data(a,b,c,!0)},acceptData:function(a){if(a.nodeName){var b=f.noData[a.nodeName.toLowerCase()];if(b)return b!==!0&&a.getAttribute("classid")===b}return!0}}),f.fn.extend({data:function(a,c){var d=null;if(typeof a=="undefined"){if(this.length){d=f.data(this[0]);if(this[0].nodeType===1){var e=this[0].attributes,g;for(var h=0,i=e.length;h<i;h++)g=e[h].name,g.indexOf("data-")===0&&(g=f.camelCase(g.substring(5)),k(this[0],g,d[g]))}}return d}if(typeof a=="object")return this.each(function(){f.data(this,a)});var j=a.split(".");j[1]=j[1]?"."+j[1]:"";if(c===b){d=this.triggerHandler("getData"+j[1]+"!",[j[0]]),d===b&&this.length&&(d=f.data(this[0],a),d=k(this[0],a,d));return d===b&&j[1]?this.data(j[0]):d}return this.each(function(){var b=f(this),d=[j[0],c];b.triggerHandler("setData"+j[1]+"!",d),f.data(this,a,c),b.triggerHandler("changeData"+j[1]+"!",d)})},removeData:function(a){return this.each(function(){f.removeData(this,a)})}}),f.extend({_mark:function(a,c){a&&(c=(c||"fx")+"mark",f.data(a,c,(f.data(a,c,b,!0)||0)+1,!0))},_unmark:function(a,c,d){a!==!0&&(d=c,c=a,a=!1);if(c){d=d||"fx";var e=d+"mark",g=a?0:(f.data(c,e,b,!0)||1)-1;g?f.data(c,e,g,!0):(f.removeData(c,e,!0),m(c,d,"mark"))}},queue:function(a,c,d){if(a){c=(c||"fx")+"queue";var e=f.data(a,c,b,!0);d&&(!e||f.isArray(d)?e=f.data(a,c,f.makeArray(d),!0):e.push(d));return e||[]}},dequeue:function(a,b){b=b||"fx";var c=f.queue(a,b),d=c.shift(),e;d==="inprogress"&&(d=c.shift()),d&&(b==="fx"&&c.unshift("inprogress"),d.call(a,function(){f.dequeue(a,b)})),c.length||(f.removeData(a,b+"queue",!0),m(a,b,"queue"))}}),f.fn.extend({queue:function(a,c){typeof a!="string"&&(c=a,a="fx");if(c===b)return f.queue(this[0],a);return this.each(function(){var b=f.queue(this,a,c);a==="fx"&&b[0]!=="inprogress"&&f.dequeue(this,a)})},dequeue:function(a){return this.each(function(){f.dequeue(this,a)})},delay:function(a,b){a=f.fx?f.fx.speeds[a]||a:a,b=b||"fx";return this.queue(b,function(){var c=this;setTimeout(function(){f.dequeue(c,b)},a)})},clearQueue:function(a){return this.queue(a||"fx",[])},promise:function(a,c){function m(){--h||d.resolveWith(e,[e])}typeof a!="string"&&(c=a,a=b),a=a||"fx";var d=f.Deferred(),e=this,g=e.length,h=1,i=a+"defer",j=a+"queue",k=a+"mark",l;while(g--)if(l=f.data(e[g],i,b,!0)||(f.data(e[g],j,b,!0)||f.data(e[g],k,b,!0))&&f.data(e[g],i,f._Deferred(),!0))h++,l.done(m);m();return d.promise()}});var n=/[\n\t\r]/g,o=/\s+/,p=/\r/g,q=/^(?:button|input)$/i,r=/^(?:button|input|object|select|textarea)$/i,s=/^a(?:rea)?$/i,t=/^(?:autofocus|autoplay|async|checked|controls|defer|disabled|hidden|loop|multiple|open|readonly|required|scoped|selected)$/i,u=/\:|^on/,v,w;f.fn.extend({attr:function(a,b){return f.access(this,a,b,!0,f.attr)},removeAttr:function(a){return this.each(function(){f.removeAttr(this,a)})},prop:function(a,b){return f.access(this,a,b,!0,f.prop)},removeProp:function(a){a=f.propFix[a]||a;return this.each(function(){try{this[a]=b,delete this[a]}catch(c){}})},addClass:function(a){var b,c,d,e,g,h,i;if(f.isFunction(a))return this.each(function(b){f(this).addClass(a.call(this,b,this.className))});if(a&&typeof a=="string"){b=a.split(o);for(c=0,d=this.length;c<d;c++){e=this[c];if(e.nodeType===1)if(!e.className&&b.length===1)e.className=a;else{g=" "+e.className+" ";for(h=0,i=b.length;h<i;h++)~g.indexOf(" "+b[h]+" ")||(g+=b[h]+" ");e.className=f.trim(g)}}}return this},removeClass:function(a){var c,d,e,g,h,i,j;if(f.isFunction(a))return this.each(function(b){f(this).removeClass(a.call(this,b,this.className))});if(a&&typeof a=="string"||a===b){c=(a||"").split(o);for(d=0,e=this.length;d<e;d++){g=this[d];if(g.nodeType===1&&g.className)if(a){h=(" "+g.className+" ").replace(n," ");for(i=0,j=c.length;i<j;i++)h=h.replace(" "+c[i]+" "," ");g.className=f.trim(h)}else g.className=""}}return this},toggleClass:function(a,b){var c=typeof a,d=typeof b=="boolean";if(f.isFunction(a))return this.each(function(c){f(this).toggleClass(a.call(this,c,this.className,b),b)});return this.each(function(){if(c==="string"){var e,g=0,h=f(this),i=b,j=a.split(o);while(e=j[g++])i=d?i:!h.hasClass(e),h[i?"addClass":"removeClass"](e)}else if(c==="undefined"||c==="boolean")this.className&&f._data(this,"__className__",this.className),this.className=this.className||a===!1?"":f._data(this,"__className__")||""})},hasClass:function(a){var b=" "+a+" ";for(var c=0,d=this.length;c<d;c++)if((" "+this[c].className+" ").replace(n," ").indexOf(b)>-1)return!0;return!1},val:function(a){var c,d,e=this[0];if(!arguments.length){if(e){c=f.valHooks[e.nodeName.toLowerCase()]||f.valHooks[e.type];if(c&&"get"in c&&(d=c.get(e,"value"))!==b)return d;d=e.value;return typeof d=="string"?d.replace(p,""):d==null?"":d}return b}var g=f.isFunction(a);return this.each(function(d){var e=f(this),h;if(this.nodeType===1){g?h=a.call(this,d,e.val()):h=a,h==null?h="":typeof h=="number"?h+="":f.isArray(h)&&(h=f.map(h,function(a){return a==null?"":a+""})),c=f.valHooks[this.nodeName.toLowerCase()]||f.valHooks[this.type];if(!c||!("set"in c)||c.set(this,h,"value")===b)this.value=h}})}}),f.extend({valHooks:{option:{get:function(a){var b=a.attributes.value;return!b||b.specified?a.value:a.text}},select:{get:function(a){var b,c=a.selectedIndex,d=[],e=a.options,g=a.type==="select-one";if(c<0)return null;for(var h=g?c:0,i=g?c+1:e.length;h<i;h++){var j=e[h];if(j.selected&&(f.support.optDisabled?!j.disabled:j.getAttribute("disabled")===null)&&(!j.parentNode.disabled||!f.nodeName(j.parentNode,"optgroup"))){b=f(j).val();if(g)return b;d.push(b)}}if(g&&!d.length&&e.length)return f(e[c]).val();return d},set:function(a,b){var c=f.makeArray(b);f(a).find("option").each(function(){this.selected=f.inArray(f(this).val(),c)>=0}),c.length||(a.selectedIndex=-1);return c}}},attrFn:{val:!0,css:!0,html:!0,text:!0,data:!0,width:!0,height:!0,offset:!0},attrFix:{tabindex:"tabIndex"},attr:function(a,c,d,e){var g=a.nodeType;if(!a||g===3||g===8||g===2)return b;if(e&&c in f.attrFn)return f(a)[c](d);if(!("getAttribute"in a))return f.prop(a,c,d);var h,i,j=g!==1||!f.isXMLDoc(a);j&&(c=f.attrFix[c]||c,i=f.attrHooks[c],i||(t.test(c)?i=w:v&&c!=="className"&&(f.nodeName(a,"form")||u.test(c))&&(i=v)));if(d!==b){if(d===null){f.removeAttr(a,c);return b}if(i&&"set"in i&&j&&(h=i.set(a,d,c))!==b)return h;a.setAttribute(c,""+d);return d}if(i&&"get"in i&&j&&(h=i.get(a,c))!==null)return h;h=a.getAttribute(c);return h===null?b:h},removeAttr:function(a,b){var c;a.nodeType===1&&(b=f.attrFix[b]||b,f.support.getSetAttribute?a.removeAttribute(b):(f.attr(a,b,""),a.removeAttributeNode(a.getAttributeNode(b))),t.test(b)&&(c=f.propFix[b]||b)in a&&(a[c]=!1))},attrHooks:{type:{set:function(a,b){if(q.test(a.nodeName)&&a.parentNode)f.error("type property can't be changed");else if(!f.support.radioValue&&b==="radio"&&f.nodeName(a,"input")){var c=a.value;a.setAttribute("type",b),c&&(a.value=c);return b}}},tabIndex:{get:function(a){var c=a.getAttributeNode("tabIndex");return c&&c.specified?parseInt(c.value,10):r.test(a.nodeName)||s.test(a.nodeName)&&a.href?0:b}},value:{get:function(a,b){if(v&&f.nodeName(a,"button"))return v.get(a,b);return b in a?a.value:null},set:function(a,b,c){if(v&&f.nodeName(a,"button"))return v.set(a,b,c);a.value=b}}},propFix:{tabindex:"tabIndex",readonly:"readOnly","for":"htmlFor","class":"className",maxlength:"maxLength",cellspacing:"cellSpacing",cellpadding:"cellPadding",rowspan:"rowSpan",colspan:"colSpan",usemap:"useMap",frameborder:"frameBorder",contenteditable:"contentEditable"},prop:function(a,c,d){var e=a.nodeType;if(!a||e===3||e===8||e===2)return b;var g,h,i=e!==1||!f.isXMLDoc(a);i&&(c=f.propFix[c]||c,h=f.propHooks[c]);return d!==b?h&&"set"in h&&(g=h.set(a,d,c))!==b?g:a[c]=d:h&&"get"in h&&(g=h.get(a,c))!==b?g:a[c]},propHooks:{}}),w={get:function(a,c){return f.prop(a,c)?c.toLowerCase():b},set:function(a,b,c){var d;b===!1?f.removeAttr(a,c):(d=f.propFix[c]||c,d in a&&(a[d]=!0),a.setAttribute(c,c.toLowerCase()));return c}},f.support.getSetAttribute||(f.attrFix=f.propFix,v=f.attrHooks.name=f.attrHooks.title=f.valHooks.button={get:function(a,c){var d;d=a.getAttributeNode(c);return d&&d.nodeValue!==""?d.nodeValue:b},set:function(a,b,c){var d=a.getAttributeNode(c);if(d){d.nodeValue=b;return b}}},f.each(["width","height"],function(a,b){f.attrHooks[b]=f.extend(f.attrHooks[b],{set:function(a,c){if(c===""){a.setAttribute(b,"auto");return c}}})})),f.support.hrefNormalized||f.each(["href","src","width","height"],function(a,c){f.attrHooks[c]=f.extend(f.attrHooks[c],{get:function(a){var d=a.getAttribute(c,2);return d===null?b:d}})}),f.support.style||(f.attrHooks.style={get:function(a){return a.style.cssText.toLowerCase()||b},set:function(a,b){return a.style.cssText=""+b}}),f.support.optSelected||(f.propHooks.selected=f.extend(f.propHooks.selected,{get:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex)}})),f.support.checkOn||f.each(["radio","checkbox"],function(){f.valHooks[this]={get:function(a){return a.getAttribute("value")===null?"on":a.value}}}),f.each(["radio","checkbox"],function(){f.valHooks[this]=f.extend(f.valHooks[this],{set:function(a,b){if(f.isArray(b))return a.checked=f.inArray(f(a).val(),b)>=0}})});var x=/\.(.*)$/,y=/^(?:textarea|input|select)$/i,z=/\./g,A=/ /g,B=/[^\w\s.|`]/g,C=function(a){return a.replace(B,"\\$&")};f.event={add:function(a,c,d,e){if(a.nodeType!==3&&a.nodeType!==8){if(d===!1)d=D;else if(!d)return;var g,h;d.handler&&(g=d,d=g.handler),d.guid||(d.guid=f.guid++);var i=f._data(a);if(!i)return;var j=i.events,k=i.handle;j||(i.events=j={}),k||(i.handle=k=function(a){return typeof f!="undefined"&&(!a||f.event.triggered!==a.type)?f.event.handle.apply(k.elem,arguments):b}),k.elem=a,c=c.split(" ");var l,m=0,n;while(l=c[m++]){h=g?f.extend({},g):{handler:d,data:e},l.indexOf(".")>-1?(n=l.split("."),l=n.shift(),h.namespace=n.slice(0).sort().join(".")):(n=[],h.namespace=""),h.type=l,h.guid||(h.guid=d.guid);var o=j[l],p=f.event.special[l]||{};if(!o){o=j[l]=[];if(!p.setup||p.setup.call(a,e,n,k)===!1)a.addEventListener?a.addEventListener(l,k,!1):a.attachEvent&&a.attachEvent("on"+l,k)}p.add&&(p.add.call(a,h),h.handler.guid||(h.handler.guid=d.guid)),o.push(h),f.event.global[l]=!0}a=null}},global:{},remove:function(a,c,d,e){if(a.nodeType!==3&&a.nodeType!==8){d===!1&&(d=D);var g,h,i,j,k=0,l,m,n,o,p,q,r,s=f.hasData(a)&&f._data(a),t=s&&s.events;if(!s||!t)return;c&&c.type&&(d=c.handler,c=c.type);if(!c||typeof c=="string"&&c.charAt(0)==="."){c=c||"";for(h in t)f.event.remove(a,h+c);return}c=c.split(" ");while(h=c[k++]){r=h,q=null,l=h.indexOf(".")<0,m=[],l||(m=h.split("."),h=m.shift(),n=new RegExp("(^|\\.)"+f.map(m.slice(0).sort(),C).join("\\.(?:.*\\.)?")+"(\\.|$)")),p=t[h];if(!p)continue;if(!d){for(j=0;j<p.length;j++){q=p[j];if(l||n.test(q.namespace))f.event.remove(a,r,q.handler,j),p.splice(j--,1)}continue}o=f.event.special[h]||{};for(j=e||0;j<p.length;j++){q=p[j];if(d.guid===q.guid){if(l||n.test(q.namespace))e==null&&p.splice(j--,1),o.remove&&o.remove.call(a,q);if(e!=null)break}}if(p.length===0||e!=null&&p.length===1)(!o.teardown||o.teardown.call(a,m)===!1)&&f.removeEvent(a,h,s.handle),g=null,delete t[h]}if(f.isEmptyObject(t)){var u=s.handle;u&&(u.elem=null),delete s.events,delete s.handle,f.isEmptyObject(s)&&f.removeData(a,b,!0)}}},customEvent:{getData:!0,setData:!0,changeData:!0},trigger:function(c,d,e,g){var h=c.type||c,i=[],j;h.indexOf("!")>=0&&(h=h.slice(0,-1),j=!0),h.indexOf(".")>=0&&(i=h.split("."),h=i.
+shift(),i.sort());if(!!e&&!f.event.customEvent[h]||!!f.event.global[h]){c=typeof c=="object"?c[f.expando]?c:new f.Event(h,c):new f.Event(h),c.type=h,c.exclusive=j,c.namespace=i.join("."),c.namespace_re=new RegExp("(^|\\.)"+i.join("\\.(?:.*\\.)?")+"(\\.|$)");if(g||!e)c.preventDefault(),c.stopPropagation();if(!e){f.each(f.cache,function(){var a=f.expando,b=this[a];b&&b.events&&b.events[h]&&f.event.trigger(c,d,b.handle.elem)});return}if(e.nodeType===3||e.nodeType===8)return;c.result=b,c.target=e,d=d!=null?f.makeArray(d):[],d.unshift(c);var k=e,l=h.indexOf(":")<0?"on"+h:"";do{var m=f._data(k,"handle");c.currentTarget=k,m&&m.apply(k,d),l&&f.acceptData(k)&&k[l]&&k[l].apply(k,d)===!1&&(c.result=!1,c.preventDefault()),k=k.parentNode||k.ownerDocument||k===c.target.ownerDocument&&a}while(k&&!c.isPropagationStopped());if(!c.isDefaultPrevented()){var n,o=f.event.special[h]||{};if((!o._default||o._default.call(e.ownerDocument,c)===!1)&&(h!=="click"||!f.nodeName(e,"a"))&&f.acceptData(e)){try{l&&e[h]&&(n=e[l],n&&(e[l]=null),f.event.triggered=h,e[h]())}catch(p){}n&&(e[l]=n),f.event.triggered=b}}return c.result}},handle:function(c){c=f.event.fix(c||a.event);var d=((f._data(this,"events")||{})[c.type]||[]).slice(0),e=!c.exclusive&&!c.namespace,g=Array.prototype.slice.call(arguments,0);g[0]=c,c.currentTarget=this;for(var h=0,i=d.length;h<i;h++){var j=d[h];if(e||c.namespace_re.test(j.namespace)){c.handler=j.handler,c.data=j.data,c.handleObj=j;var k=j.handler.apply(this,g);k!==b&&(c.result=k,k===!1&&(c.preventDefault(),c.stopPropagation()));if(c.isImmediatePropagationStopped())break}}return c.result},props:"altKey attrChange attrName bubbles button cancelable charCode clientX clientY ctrlKey currentTarget data detail eventPhase fromElement handler keyCode layerX layerY metaKey newValue offsetX offsetY pageX pageY prevValue relatedNode relatedTarget screenX screenY shiftKey srcElement target toElement view wheelDelta which".split(" "),fix:function(a){if(a[f.expando])return a;var d=a;a=f.Event(d);for(var e=this.props.length,g;e;)g=this.props[--e],a[g]=d[g];a.target||(a.target=a.srcElement||c),a.target.nodeType===3&&(a.target=a.target.parentNode),!a.relatedTarget&&a.fromElement&&(a.relatedTarget=a.fromElement===a.target?a.toElement:a.fromElement);if(a.pageX==null&&a.clientX!=null){var h=a.target.ownerDocument||c,i=h.documentElement,j=h.body;a.pageX=a.clientX+(i&&i.scrollLeft||j&&j.scrollLeft||0)-(i&&i.clientLeft||j&&j.clientLeft||0),a.pageY=a.clientY+(i&&i.scrollTop||j&&j.scrollTop||0)-(i&&i.clientTop||j&&j.clientTop||0)}a.which==null&&(a.charCode!=null||a.keyCode!=null)&&(a.which=a.charCode!=null?a.charCode:a.keyCode),!a.metaKey&&a.ctrlKey&&(a.metaKey=a.ctrlKey),!a.which&&a.button!==b&&(a.which=a.button&1?1:a.button&2?3:a.button&4?2:0);return a},guid:1e8,proxy:f.proxy,special:{ready:{setup:f.bindReady,teardown:f.noop},live:{add:function(a){f.event.add(this,N(a.origType,a.selector),f.extend({},a,{handler:M,guid:a.handler.guid}))},remove:function(a){f.event.remove(this,N(a.origType,a.selector),a)}},beforeunload:{setup:function(a,b,c){f.isWindow(this)&&(this.onbeforeunload=c)},teardown:function(a,b){this.onbeforeunload===b&&(this.onbeforeunload=null)}}}},f.removeEvent=c.removeEventListener?function(a,b,c){a.removeEventListener&&a.removeEventListener(b,c,!1)}:function(a,b,c){a.detachEvent&&a.detachEvent("on"+b,c)},f.Event=function(a,b){if(!this.preventDefault)return new f.Event(a,b);a&&a.type?(this.originalEvent=a,this.type=a.type,this.isDefaultPrevented=a.defaultPrevented||a.returnValue===!1||a.getPreventDefault&&a.getPreventDefault()?E:D):this.type=a,b&&f.extend(this,b),this.timeStamp=f.now(),this[f.expando]=!0},f.Event.prototype={preventDefault:function(){this.isDefaultPrevented=E;var a=this.originalEvent;!a||(a.preventDefault?a.preventDefault():a.returnValue=!1)},stopPropagation:function(){this.isPropagationStopped=E;var a=this.originalEvent;!a||(a.stopPropagation&&a.stopPropagation(),a.cancelBubble=!0)},stopImmediatePropagation:function(){this.isImmediatePropagationStopped=E,this.stopPropagation()},isDefaultPrevented:D,isPropagationStopped:D,isImmediatePropagationStopped:D};var F=function(a){var b=a.relatedTarget,c=!1,d=a.type;a.type=a.data,b!==this&&(b&&(c=f.contains(this,b)),c||(f.event.handle.apply(this,arguments),a.type=d))},G=function(a){a.type=a.data,f.event.handle.apply(this,arguments)};f.each({mouseenter:"mouseover",mouseleave:"mouseout"},function(a,b){f.event.special[a]={setup:function(c){f.event.add(this,b,c&&c.selector?G:F,a)},teardown:function(a){f.event.remove(this,b,a&&a.selector?G:F)}}}),f.support.submitBubbles||(f.event.special.submit={setup:function(a,b){if(!f.nodeName(this,"form"))f.event.add(this,"click.specialSubmit",function(a){var b=a.target,c=b.type;(c==="submit"||c==="image")&&f(b).closest("form").length&&K("submit",this,arguments)}),f.event.add(this,"keypress.specialSubmit",function(a){var b=a.target,c=b.type;(c==="text"||c==="password")&&f(b).closest("form").length&&a.keyCode===13&&K("submit",this,arguments)});else return!1},teardown:function(a){f.event.remove(this,".specialSubmit")}});if(!f.support.changeBubbles){var H,I=function(a){var b=a.type,c=a.value;b==="radio"||b==="checkbox"?c=a.checked:b==="select-multiple"?c=a.selectedIndex>-1?f.map(a.options,function(a){return a.selected}).join("-"):"":f.nodeName(a,"select")&&(c=a.selectedIndex);return c},J=function(c){var d=c.target,e,g;if(!!y.test(d.nodeName)&&!d.readOnly){e=f._data(d,"_change_data"),g=I(d),(c.type!=="focusout"||d.type!=="radio")&&f._data(d,"_change_data",g);if(e===b||g===e)return;if(e!=null||g)c.type="change",c.liveFired=b,f.event.trigger(c,arguments[1],d)}};f.event.special.change={filters:{focusout:J,beforedeactivate:J,click:function(a){var b=a.target,c=f.nodeName(b,"input")?b.type:"";(c==="radio"||c==="checkbox"||f.nodeName(b,"select"))&&J.call(this,a)},keydown:function(a){var b=a.target,c=f.nodeName(b,"input")?b.type:"";(a.keyCode===13&&!f.nodeName(b,"textarea")||a.keyCode===32&&(c==="checkbox"||c==="radio")||c==="select-multiple")&&J.call(this,a)},beforeactivate:function(a){var b=a.target;f._data(b,"_change_data",I(b))}},setup:function(a,b){if(this.type==="file")return!1;for(var c in H)f.event.add(this,c+".specialChange",H[c]);return y.test(this.nodeName)},teardown:function(a){f.event.remove(this,".specialChange");return y.test(this.nodeName)}},H=f.event.special.change.filters,H.focus=H.beforeactivate}f.support.focusinBubbles||f.each({focus:"focusin",blur:"focusout"},function(a,b){function e(a){var c=f.event.fix(a);c.type=b,c.originalEvent={},f.event.trigger(c,null,c.target),c.isDefaultPrevented()&&a.preventDefault()}var d=0;f.event.special[b]={setup:function(){d++===0&&c.addEventListener(a,e,!0)},teardown:function(){--d===0&&c.removeEventListener(a,e,!0)}}}),f.each(["bind","one"],function(a,c){f.fn[c]=function(a,d,e){var g;if(typeof a=="object"){for(var h in a)this[c](h,d,a[h],e);return this}if(arguments.length===2||d===!1)e=d,d=b;c==="one"?(g=function(a){f(this).unbind(a,g);return e.apply(this,arguments)},g.guid=e.guid||f.guid++):g=e;if(a==="unload"&&c!=="one")this.one(a,d,e);else for(var i=0,j=this.length;i<j;i++)f.event.add(this[i],a,g,d);return this}}),f.fn.extend({unbind:function(a,b){if(typeof a=="object"&&!a.preventDefault)for(var c in a)this.unbind(c,a[c]);else for(var d=0,e=this.length;d<e;d++)f.event.remove(this[d],a,b);return this},delegate:function(a,b,c,d){return this.live(b,c,d,a)},undelegate:function(a,b,c){return arguments.length===0?this.unbind("live"):this.die(b,null,c,a)},trigger:function(a,b){return this.each(function(){f.event.trigger(a,b,this)})},triggerHandler:function(a,b){if(this[0])return f.event.trigger(a,b,this[0],!0)},toggle:function(a){var b=arguments,c=a.guid||f.guid++,d=0,e=function(c){var e=(f.data(this,"lastToggle"+a.guid)||0)%d;f.data(this,"lastToggle"+a.guid,e+1),c.preventDefault();return b[e].apply(this,arguments)||!1};e.guid=c;while(d<b.length)b[d++].guid=c;return this.click(e)},hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}});var L={focus:"focusin",blur:"focusout",mouseenter:"mouseover",mouseleave:"mouseout"};f.each(["live","die"],function(a,c){f.fn[c]=function(a,d,e,g){var h,i=0,j,k,l,m=g||this.selector,n=g?this:f(this.context);if(typeof a=="object"&&!a.preventDefault){for(var o in a)n[c](o,d,a[o],m);return this}if(c==="die"&&!a&&g&&g.charAt(0)==="."){n.unbind(g);return this}if(d===!1||f.isFunction(d))e=d||D,d=b;a=(a||"").split(" ");while((h=a[i++])!=null){j=x.exec(h),k="",j&&(k=j[0],h=h.replace(x,""));if(h==="hover"){a.push("mouseenter"+k,"mouseleave"+k);continue}l=h,L[h]?(a.push(L[h]+k),h=h+k):h=(L[h]||h)+k;if(c==="live")for(var p=0,q=n.length;p<q;p++)f.event.add(n[p],"live."+N(h,m),{data:d,selector:m,handler:e,origType:h,origHandler:e,preType:l});else n.unbind("live."+N(h,m),e)}return this}}),f.each("blur focus focusin focusout load resize scroll unload click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup error".split(" "),function(a,b){f.fn[b]=function(a,c){c==null&&(c=a,a=null);return arguments.length>0?this.bind(b,a,c):this.trigger(b)},f.attrFn&&(f.attrFn[b]=!0)}),function(){function u(a,b,c,d,e,f){for(var g=0,h=d.length;g<h;g++){var i=d[g];if(i){var j=!1;i=i[a];while(i){if(i.sizcache===c){j=d[i.sizset];break}if(i.nodeType===1){f||(i.sizcache=c,i.sizset=g);if(typeof b!="string"){if(i===b){j=!0;break}}else if(k.filter(b,[i]).length>0){j=i;break}}i=i[a]}d[g]=j}}}function t(a,b,c,d,e,f){for(var g=0,h=d.length;g<h;g++){var i=d[g];if(i){var j=!1;i=i[a];while(i){if(i.sizcache===c){j=d[i.sizset];break}i.nodeType===1&&!f&&(i.sizcache=c,i.sizset=g);if(i.nodeName.toLowerCase()===b){j=i;break}i=i[a]}d[g]=j}}}var a=/((?:\((?:\([^()]+\)|[^()]+)+\)|\[(?:\[[^\[\]]*\]|['"][^'"]*['"]|[^\[\]'"]+)+\]|\\.|[^ >+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,d=0,e=Object.prototype.toString,g=!1,h=!0,i=/\\/g,j=/\W/;[0,0].sort(function(){h=!1;return 0});var k=function(b,d,f,g){f=f||[],d=d||c;var h=d;if(d.nodeType!==1&&d.nodeType!==9)return[];if(!b||typeof b!="string")return f;var i,j,n,o,q,r,s,t,u=!0,w=k.isXML(d),x=[],y=b;do{a.exec(""),i=a.exec(y);if(i){y=i[3],x.push(i[1]);if(i[2]){o=i[3];break}}}while(i);if(x.length>1&&m.exec(b))if(x.length===2&&l.relative[x[0]])j=v(x[0]+x[1],d);else{j=l.relative[x[0]]?[d]:k(x.shift(),d);while(x.length)b=x.shift(),l.relative[b]&&(b+=x.shift()),j=v(b,j)}else{!g&&x.length>1&&d.nodeType===9&&!w&&l.match.ID.test(x[0])&&!l.match.ID.test(x[x.length-1])&&(q=k.find(x.shift(),d,w),d=q.expr?k.filter(q.expr,q.set)[0]:q.set[0]);if(d){q=g?{expr:x.pop(),set:p(g)}:k.find(x.pop(),x.length===1&&(x[0]==="~"||x[0]==="+")&&d.parentNode?d.parentNode:d,w),j=q.expr?k.filter(q.expr,q.set):q.set,x.length>0?n=p(j):u=!1;while(x.length)r=x.pop(),s=r,l.relative[r]?s=x.pop():r="",s==null&&(s=d),l.relative[r](n,s,w)}else n=x=[]}n||(n=j),n||k.error(r||b);if(e.call(n)==="[object Array]")if(!u)f.push.apply(f,n);else if(d&&d.nodeType===1)for(t=0;n[t]!=null;t++)n[t]&&(n[t]===!0||n[t].nodeType===1&&k.contains(d,n[t]))&&f.push(j[t]);else for(t=0;n[t]!=null;t++)n[t]&&n[t].nodeType===1&&f.push(j[t]);else p(n,f);o&&(k(o,h,f,g),k.uniqueSort(f));return f};k.uniqueSort=function(a){if(r){g=h,a.sort(r);if(g)for(var b=1;b<a.length;b++)a[b]===a[b-1]&&a.splice(b--,1)}return a},k.matches=function(a,b){return k(a,null,null,b)},k.matchesSelector=function(a,b){return k(b,null,null,[a]).length>0},k.find=function(a,b,c){var d;if(!a)return[];for(var e=0,f=l.order.length;e<f;e++){var g,h=l.order[e];if(g=l.leftMatch[h].exec(a)){var j=g[1];g.splice(1,1);if(j.substr(j.length-1)!=="\\"){g[1]=(g[1]||"").replace(i,""),d=l.find[h](g,b,c);if(d!=null){a=a.replace(l.match[h],"");break}}}}d||(d=typeof b.getElementsByTagName!="undefined"?b.getElementsByTagName("*"):[]);return{set:d,expr:a}},k.filter=function(a,c,d,e){var f,g,h=a,i=[],j=c,m=c&&c[0]&&k.isXML(c[0]);while(a&&c.length){for(var n in l.filter)if((f=l.leftMatch[n].exec(a))!=null&&f[2]){var o,p,q=l.filter[n],r=f[1];g=!1,f.splice(1,1);if(r.substr(r.length-1)==="\\")continue;j===i&&(i=[]);if(l.preFilter[n]){f=l.preFilter[n](f,j,d,i,e,m);if(!f)g=o=!0;else if(f===!0)continue}if(f)for(var s=0;(p=j[s])!=null;s++)if(p){o=q(p,f,s,j);var t=e^!!o;d&&o!=null?t?g=!0:j[s]=!1:t&&(i.push(p),g=!0)}if(o!==b){d||(j=i),a=a.replace(l.match[n],"");if(!g)return[];break}}if(a===h)if(g==null)k.error(a);else break;h=a}return j},k.error=function(a){throw"Syntax error, unrecognized expression: "+a};var l=k.selectors={order:["ID","NAME","TAG"],match:{ID:/#((?:[\w\u00c0-\uFFFF\-]|\\.)+)/,CLASS:/\.((?:[\w\u00c0-\uFFFF\-]|\\.)+)/,NAME:/\[name=['"]*((?:[\w\u00c0-\uFFFF\-]|\\.)+)['"]*\]/,ATTR:/\[\s*((?:[\w\u00c0-\uFFFF\-]|\\.)+)\s*(?:(\S?=)\s*(?:(['"])(.*?)\3|(#?(?:[\w\u00c0-\uFFFF\-]|\\.)*)|)|)\s*\]/,TAG:/^((?:[\w\u00c0-\uFFFF\*\-]|\\.)+)/,CHILD:/:(only|nth|last|first)-child(?:\(\s*(even|odd|(?:[+\-]?\d+|(?:[+\-]?\d*)?n\s*(?:[+\-]\s*\d+)?))\s*\))?/,POS:/:(nth|eq|gt|lt|first|last|even|odd)(?:\((\d*)\))?(?=[^\-]|$)/,PSEUDO:/:((?:[\w\u00c0-\uFFFF\-]|\\.)+)(?:\((['"]?)((?:\([^\)]+\)|[^\(\)]*)+)\2\))?/},leftMatch:{},attrMap:{"class":"className","for":"htmlFor"},attrHandle:{href:function(a){return a.getAttribute("href")},type:function(a){return a.getAttribute("type")}},relative:{"+":function(a,b){var c=typeof b=="string",d=c&&!j.test(b),e=c&&!d;d&&(b=b.toLowerCase());for(var f=0,g=a.length,h;f<g;f++)if(h=a[f]){while((h=h.previousSibling)&&h.nodeType!==1);a[f]=e||h&&h.nodeName.toLowerCase()===b?h||!1:h===b}e&&k.filter(b,a,!0)},">":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!j.test(b)){b=b.toLowerCase();for(;e<f;e++){c=a[e];if(c){var g=c.parentNode;a[e]=g.nodeName.toLowerCase()===b?g:!1}}}else{for(;e<f;e++)c=a[e],c&&(a[e]=d?c.parentNode:c.parentNode===b);d&&k.filter(b,a,!0)}},"":function(a,b,c){var e,f=d++,g=u;typeof b=="string"&&!j.test(b)&&(b=b.toLowerCase(),e=b,g=t),g("parentNode",b,f,a,e,c)},"~":function(a,b,c){var e,f=d++,g=u;typeof b=="string"&&!j.test(b)&&(b=b.toLowerCase(),e=b,g=t),g("previousSibling",b,f,a,e,c)}},find:{ID:function(a,b,c){if(typeof b.getElementById!="undefined"&&!c){var d=b.getElementById(a[1]);return d&&d.parentNode?[d]:[]}},NAME:function(a,b){if(typeof b.getElementsByName!="undefined"){var c=[],d=b.getElementsByName(a[1]);for(var e=0,f=d.length;e<f;e++)d[e].getAttribute("name")===a[1]&&c.push(d[e]);return c.length===0?null:c}},TAG:function(a,b){if(typeof b.getElementsByTagName!="undefined")return b.getElementsByTagName(a[1])}},preFilter:{CLASS:function(a,b,c,d,e,f){a=" "+a[1].replace(i,"")+" ";if(f)return a;for(var g=0,h;(h=b[g])!=null;g++)h&&(e^(h.className&&(" "+h.className+" ").replace(/[\t\n\r]/g," ").indexOf(a)>=0)?c||d.push(h):c&&(b[g]=!1));return!1},ID:function(a){return a[1].replace(i,"")},TAG:function(a,b){return a[1].replace(i,"").toLowerCase()},CHILD:function(a){if(a[1]==="nth"){a[2]||k.error(a[0]),a[2]=a[2].replace(/^\+|\s*/g,"");var b=/(-?)(\d*)(?:n([+\-]?\d*))?/.exec(a[2]==="even"&&"2n"||a[2]==="odd"&&"2n+1"||!/\D/.test(a[2])&&"0n+"+a[2]||a[2]);a[2]=b[1]+(b[2]||1)-0,a[3]=b[3]-0}else a[2]&&k.error(a[0]);a[0]=d++;return a},ATTR:function(a,b,c,d,e,f){var g=a[1]=a[1].replace(i,"");!f&&l.attrMap[g]&&(a[1]=l.attrMap[g]),a[4]=(a[4]||a[5]||"").replace(i,""),a[2]==="~="&&(a[4]=" "+a[4]+" ");return a},PSEUDO:function(b,c,d,e,f){if(b[1]==="not")if((a.exec(b[3])||"").length>1||/^\w/.test(b[3]))b[3]=k(b[3],null,null,c);else{var g=k.filter(b[3],c,d,!0^f);d||e.push.apply(e,g);return!1}else if(l.match.POS.test(b[0])||l.match.CHILD.test(b[0]))return!0;return b},POS:function(a){a.unshift(!0);return a}},filters:{enabled:function(a){return a.disabled===!1&&a.type!=="hidden"},disabled:function(a){return a.disabled===!0},checked:function(a){return a.checked===!0},selected:function(a){a.parentNode&&a.parentNode.selectedIndex;return a.selected===!0},parent:function(a){return!!a.firstChild},empty:function(a){return!a.firstChild},has:function(a,b,c){return!!k(c[3],a).length},header:function(a){return/h\d/i.test(a.nodeName)},text:function(a){var b=a.getAttribute("type"),c=a.type;return a.nodeName.toLowerCase()==="input"&&"text"===c&&(b===c||b===null)},radio:function(a){return a.nodeName.toLowerCase()==="input"&&"radio"===a.type},checkbox:function(a){return a.nodeName.toLowerCase()==="input"&&"checkbox"===a.type},file:function(a){return a.nodeName.toLowerCase()==="input"&&"file"===a.type},password:function(a){return a.nodeName.toLowerCase()==="input"&&"password"===a.type},submit:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"submit"===a.type},image:function(a){return a.nodeName.toLowerCase()==="input"&&"image"===a.type},reset:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"reset"===a.type},button:function(a){var b=a.nodeName.toLowerCase();return b==="input"&&"button"===a.type||b==="button"},input:function(a){return/input|select|textarea|button/i.test(a.nodeName)},focus:function(a){return a===a.ownerDocument.activeElement}},setFilters:{first:function(a,b){return b===0},last:function(a,b,c,d){return b===d.length-1},even:function(a,b){return b%2===0},odd:function(a,b){return b%2===1},lt:function(a,b,c){return b<c[3]-0},gt:function(a,b,c){return b>c[3]-0},nth:function(a,b,c){return c[3]-0===b},eq:function(a,b,c){return c[3]-0===b}},filter:{PSEUDO:function(a,b,c,d){var e=b[1],f=l.filters[e];if(f)return f(a,c,b,d);if(e==="contains")return(a.textContent||a.innerText||k.getText([a])||"").indexOf(b[3])>=0;if(e==="not"){var g=b[3];for(var h=0,i=g.length;h<i;h++)if(g[h]===a)return!1;return!0}k.error(e)},CHILD:function(a,b){var c=b[1],d=a;switch(c){case"only":case"first":while(d=d.previousSibling)if(d.nodeType===1)return!1;if(c==="first")return!0;d=a;case"last":while(d=d.nextSibling)if(d.nodeType===1)return!1;return!0;case"nth":var e=b[2],f=b[3];if(e===1&&f===0)return!0;var g=b[0],h=a.parentNode;if(h&&(h.sizcache!==g||!a.nodeIndex)){var i=0;for(d=h.firstChild;d;d=d.nextSibling)d.nodeType===1&&(d.nodeIndex=++i);h.sizcache=g}var j=a.nodeIndex-f;return e===0?j===0:j%e===0&&j/e>=0}},ID:function(a,b){return a.nodeType===1&&a.getAttribute("id")===b},TAG:function(a,b){return b==="*"&&a.nodeType===1||a.nodeName.toLowerCase()===b},CLASS:function(a,b){return(" "+(a.className||a.getAttribute("class"))+" ").indexOf(b)>-1},ATTR:function(a,b){var c=b[1],d=l.attrHandle[c]?l.attrHandle[c](a):a[c]!=null?a[c]:a.getAttribute(c),e=d+"",f=b[2],g=b[4];return d==null?f==="!=":f==="="?e===g:f==="*="?e.indexOf(g)>=0:f==="~="?(" "+e+" ").indexOf(g)>=0:g?f==="!="?e!==g:f==="^="?e.indexOf(g)===0:f==="$="?e.substr(e.length-g.length)===g:f==="|="?e===g||e.substr(0,g.length+1)===g+"-":!1:e&&d!==!1},POS:function(a,b,c,d){var e=b[2],f=l.setFilters[e];if(f)return f(a,c,b,d)}}},m=l.match.POS,n=function(a,b){return"\\"+(b-0+1)};for(var o in l.match)l.match[o]=new RegExp(l.match[o].source+/(?![^\[]*\])(?![^\(]*\))/.source),l.leftMatch[o]=new RegExp(/(^(?:.|\r|\n)*?)/.source+l.match[o].source.replace(/\\(\d+)/g,n));var p=function(a,b){a=Array.prototype.slice.call(a,0);if(b){b.push.apply(b,a);return b}return a};try{Array.prototype.slice.call(c.documentElement.childNodes,0)[0].nodeType}catch(q){p=function(a,b){var c=0,d=b||[];if(e.call(a)==="[object Array]")Array.prototype.push.apply(d,a);else if(typeof a.length=="number")for(var f=a.length;c<f;c++)d.push(a[c]);else for(;a[c];c++)d.push(a[c]);return d}}var r,s;c.documentElement.compareDocumentPosition?r=function(a,b){if(a===b){g=!0;return 0}if(!a.compareDocumentPosition||!b.compareDocumentPosition)return a.compareDocumentPosition?-1:1;return a.compareDocumentPosition(b)&4?-1:1}:(r=function(a,b){if(a===b){g=!0;return 0}if(a.sourceIndex&&b.sourceIndex)return a.sourceIndex-b.sourceIndex;var c,d,e=[],f=[],h=a.parentNode,i=b.parentNode,j=h;if(h===i)return s(a,b);if(!h)return-1;if(!i)return 1;while(j)e.unshift(j),j=j.parentNode;j=i;while(j)f.unshift(j),j=j.parentNode;c=e.length,d=f.length;for(var k=0;k<c&&k<d;k++)if(e[k]!==f[k])return s(e[k],f[k]);return k===c?s(a,f[k],-1):s(e[k],b,1)},s=function(a,b,c){if(a===b)return c;var d=a.nextSibling;while(d){if(d===b)return-1;d=d.nextSibling}return 1}),k.getText=function(a){var b="",c;for(var d=0;a[d];d++)c=a[d],c.nodeType===3||c.nodeType===4?b+=c.nodeValue:c.nodeType!==8&&(b+=k.getText(c.childNodes));return b},function(){var a=c.createElement("div"),d="script"+(new Date).getTime(),e=c.documentElement;a.innerHTML="<a name='"+d+"'/>",e.insertBefore(a,e.firstChild),c.getElementById(d)&&(l.find.ID=function(a,c,d){if(typeof c.getElementById!="undefined"&&!d){var e=c.getElementById(a[1]);return e?e.id===a[1]||typeof e.getAttributeNode!="undefined"&&e.getAttributeNode("id").nodeValue===a[1]?[e]:b:[]}},l.filter.ID=function(a,b){var c=typeof a.getAttributeNode!="undefined"&&a.getAttributeNode("id");return a.nodeType===1&&c&&c.nodeValue===b}),e.removeChild(a),e=a=null}(),function(){var a=c.createElement("div");a.appendChild(c.createComment("")),a.getElementsByTagName("*").length>0&&(l.find.TAG=function(a,b){var c=b.getElementsByTagName(a[1]);if(a[1]==="*"){var d=[];for(var e=0;c[e];e++)c[e].nodeType===1&&d.push(c[e]);c=d}return c}),a.innerHTML="<a href='#'></a>",a.firstChild&&typeof a.firstChild.getAttribute!="undefined"&&a.firstChild.getAttribute("href")!=="#"&&(l.attrHandle.href=function(a){return a.getAttribute("href",2)}),a=null}(),c.querySelectorAll&&function(){var a=k,b=c.createElement("div"),d="__sizzle__";b.innerHTML="<p class='TEST'></p>";if(!b.querySelectorAll||b.querySelectorAll(".TEST").length!==0){k=function(b,e,f,g){e=e||c;if(!g&&!k.isXML(e)){var h=/^(\w+$)|^\.([\w\-]+$)|^#([\w\-]+$)/.exec(b);if(h&&(e.nodeType===1||e.nodeType===9)){if(h[1])return p(e.getElementsByTagName(b),f);if(h[2]&&l.find.CLASS&&e.getElementsByClassName)return p(e.getElementsByClassName(h[2]),f)}if(e.nodeType===9){if(b==="body"&&e.body)return p([e.body],f);if(h&&h[3]){var i=e.getElementById(h[3]);if(!i||!i.parentNode)return p([],f);if(i.id===h[3])return p([i],f)}try{return p(e.querySelectorAll(b),f)}catch(j){}}else if(e.nodeType===1&&e.nodeName.toLowerCase()!=="object"){var m=e,n=e.getAttribute("id"),o=n||d,q=e.parentNode,r=/^\s*[+~]/.test(b);n?o=o.replace(/'/g,"\\$&"):e.setAttribute("id",o),r&&q&&(e=e.parentNode);try{if(!r||q)return p(e.querySelectorAll("[id='"+o+"'] "+b),f)}catch(s){}finally{n||m.removeAttribute("id")}}}return a(b,e,f,g)};for(var e in a)k[e]=a[e];b=null}}(),function(){var a=c.documentElement,b=a.matchesSelector||a.mozMatchesSelector||a.webkitMatchesSelector||a.msMatchesSelector;if(b){var d=!b.call(c.createElement("div"),"div"),e=!1;try{b.call(c.documentElement,"[test!='']:sizzle")}catch(f){e=!0}k.matchesSelector=function(a,c){c=c.replace(/\=\s*([^'"\]]*)\s*\]/g,"='$1']");if(!k.isXML(a))try{if(e||!l.match.PSEUDO.test(c)&&!/!=/.test(c)){var f=b.call(a,c);if(f||!d||a.document&&a.document.nodeType!==11)return f}}catch(g){}return k(c,null,null,[a]).length>0}}}(),function(){var a=c.createElement("div");a.innerHTML="<div class='test e'></div><div class='test'></div>";if(!!a.getElementsByClassName&&a.getElementsByClassName("e").length!==0){a.lastChild.className="e";if(a.getElementsByClassName("e").length===1)return;l.order.splice(1,0,"CLASS"),l.find.CLASS=function(a,b,c){if(typeof b.getElementsByClassName!="undefined"&&!c)return b.getElementsByClassName(a[1])},a=null}}(),c.documentElement.contains?k.contains=function(a,b){return a!==b&&(a.contains?a.contains(b):!0)}:c.documentElement.compareDocumentPosition?k.contains=function(a,b){return!!(a.compareDocumentPosition(b)&16)}:k.contains=function(){return!1},k.isXML=function(a){var b=(a?a.ownerDocument||a:0).documentElement;return b?b.nodeName!=="HTML":!1};var v=function(a,b){var c,d=[],e="",f=b.nodeType?[b]:b;while(c=l.match.PSEUDO.exec(a))e+=c[0],a=a.replace(l.match.PSEUDO,"");a=l.relative[a]?a+"*":a;for(var g=0,h=f.length;g<h;g++)k(a,f[g],d);return k.filter(e,d)};f.find=k,f.expr=k.selectors,f.expr[":"]=f.expr.filters,f.unique=k.uniqueSort,f.text=k.getText,f.isXMLDoc=k.isXML,f.contains=k.contains}();var O=/Until$/,P=/^(?:parents|prevUntil|prevAll)/,Q=/,/,R=/^.[^:#\[\.,]*$/,S=Array.prototype.slice,T=f.expr.match.POS,U={children:!0,contents:!0,next:!0,prev:!0};f.fn.extend({find:function(a){var b=this,c,d;if(typeof a!="string")return f(a).filter(function(){for(c=0,d=b.length;c<d;c++)if(f.contains(b[c],this))return!0});var e=this.pushStack("","find",a),g,h,i;for(c=0,d=this.length;c<d;c++){g=e.length,f.find(a,this[c],e);if(c>0)for(h=g;h<e.length;h++)for(i=0;i<g;i++)if(e[i]===e[h]){e.splice(h--,1);break}}return e},has:function(a){var b=f(a);return this.filter(function(){for(var a=0,c=b.length;a<c;a++)if(f.contains(this,b[a]))return!0})},not:function(a){return this.pushStack(W(this,a,!1),"not",a)},filter:function(a){return this.pushStack(W(this,a,!0),"filter",a)},is:function(a){return!!a&&(typeof a=="string"?f.filter(a,this).length>0:this.filter(a).length>0)},closest:function(a,b){var c=[],d,e,g=this[0];if(f.isArray(a)){var h,i,j={},k=1;if(g&&a.length){for(d=0,e=a.length;d<e;d++)i=a[d],j[i]||(j[i]=T.test(i)?f(i,b||this.context):i);while(g&&g.ownerDocument&&g!==b){for(i in j)h=j[i],(h.jquery?h.index(g)>-1:f(g).is(h))&&c.push({selector:i,elem:g,level:k});g=g.parentNode,k++}}return c}var l=T.test(a)||typeof a!="string"?f(a,b||this.context):0;for(d=0,e=this.length;d<e;d++){g=this[d];while(g){if(l?l.index(g)>-1:f.find.matchesSelector(g,a)){c.push(g);break}g=g.parentNode;if(!g||!g.ownerDocument||g===b||g.nodeType===11)break}}c=c.length>1?f.unique(c):c;return this.pushStack(c,"closest",a)},index:function(a){if(!a||typeof a=="string")return f.inArray(this[0],a?f(a):this.parent().children());return f.inArray(a.jquery?a[0]:a,this)},add:function(a,b){var c=typeof a=="string"?f(a,b):f.makeArray(a&&a.nodeType?[a]:a),d=f.merge(this.get(),c);return this.pushStack(V(c[0])||V(d[0])?d:f.unique(d))},andSelf:function(){return this.add(this.prevObject)}}),f.each({parent:function(a){var b=a.parentNode;return b&&b.nodeType!==11?b:null},parents:function(a){return f.dir(a,"parentNode")},parentsUntil:function(a,b,c){return f.dir(a,"parentNode",c)},next:function(a){return f.nth(a,2,"nextSibling")},prev:function(a){return f.nth(a,2,"previousSibling")},nextAll:function(a){return f.dir(a,"nextSibling")},prevAll:function(a){return f.dir(a,"previousSibling")},nextUntil:function(a,b,c){return f.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return f.dir(a,"previousSibling",c)},siblings:function(a){return f.sibling(a.parentNode.firstChild,a)},children:function(a){return f.sibling(a.firstChild)},contents:function(a){return f.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:f.makeArray(a.childNodes)}},function(a,b){f.fn[a]=function(c,d){var e=f.map(this,b,c),g=S.call(arguments);O.test(a)||(d=c),d&&typeof d=="string"&&(e=f.filter(d,e)),e=this.length>1&&!U[a]?f.unique(e):e,(this.length>1||Q.test(d))&&P.test(a)&&(e=e.reverse());return this.pushStack(e,a,g.join(","))}}),f.extend({filter:function(a,b,c){c&&(a=":not("+a+")");return b.length===1?f.find.matchesSelector(b[0],a)?[b[0]]:[]:f.find.matches(a,b)},dir:function(a,c,d){var e=[],g=a[c];while(g&&g.nodeType!==9&&(d===b||g.nodeType!==1||!f(g).is(d)))g.nodeType===1&&e.push(g),g=g[c];return e},nth:function(a,b,c,d){b=b||1;var e=0;for(;a;a=a[c])if(a.nodeType===1&&++e===b)break;return a},sibling:function(a,b){var c=[];for(;a;a=a.nextSibling)a.nodeType===1&&a!==b&&c.push(a);return c}});var X=/ jQuery\d+="(?:\d+|null)"/g,Y=/^\s+/,Z=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/ig,$=/<([\w:]+)/,_=/<tbody/i,ba=/<|&#?\w+;/,bb=/<(?:script|object|embed|option|style)/i,bc=/checked\s*(?:[^=]|=\s*.checked.)/i,bd=/\/(java|ecma)script/i,be=/^\s*<!(?:\[CDATA\[|\-\-)/,bf={option:[1,"<select multiple='multiple'>","</select>"],legend:[1,"<fieldset>","</fieldset>"],thead:[1,"<table>","</table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],col:[2,"<table><tbody></tbody><colgroup>","</colgroup></table>"],area:[1,"<map>","</map>"],_default:[0,"",""]};bf.optgroup=bf.option,bf.tbody=bf.tfoot=bf.colgroup=bf.caption=bf.thead,bf.th=bf.td,f.support.htmlSerialize||(bf._default=[1,"div<div>","</div>"]),f.fn.extend({text:function(a){if(f.isFunction(a))return this.each(function(b){var c=f(this);c.text(a.call(this,b,c.text()))});if(typeof a!="object"&&a!==b)return this.empty().append((this[0]&&this[0].ownerDocument||c).createTextNode(a));return f.text(this)},wrapAll:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapAll(a.call(this,b))});if(this[0]){var b=f(a,this[0].ownerDocument).eq(0).clone(!0);this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstChild&&a.firstChild.nodeType===1)a=a.firstChild;return a}).append(this)}return this},wrapInner:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapInner(a.call(this,b))});return this.each(function(){var b=f(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){return this.each(function(){f(this).wrapAll(a)})},unwrap:function(){return this.parent().each(function(){f.nodeName(this,"body")||f(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.appendChild(a)})},prepend:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this)});if(arguments.length){var a=f(arguments[0]);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this.nextSibling)});if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,f(arguments[0]).toArray());return a}},remove:function(a,b){for(var c=0,d;(d=this[c])!=null;c++)if(!a||f.filter(a,[d]).length)!b&&d.nodeType===1&&(f.cleanData(d.getElementsByTagName("*")),f.cleanData([d])),d.parentNode&&d.parentNode.removeChild(d);return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++){b.nodeType===1&&f.cleanData(b.getElementsByTagName("*"));while(b.firstChild)b.removeChild(b.firstChild)}return this},clone:function(a,b){a=a==null?!1:a,b=b==null?a:b;return this.map(function(){return f.clone(this,a,b)})},html:function(a){if(a===b)return this[0]&&this[0].nodeType===1?this[0].innerHTML.replace(X,""):null;if(typeof a=="string"&&!bb.test(a)&&(f.support.leadingWhitespace||!Y.test(a))&&!bf[($.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Z,"<$1></$2>");try{for(var c=0,d=this.length;c<d;c++)this[c].nodeType===1&&(f.cleanData(this[c].getElementsByTagName("*")),this[c].innerHTML=a)}catch(e){this.empty().append(a)}}else f.isFunction(a)?this.each(function(b){var c=f(this);c.html(a.call(this,b,c.html()))}):this.empty().append(a);return this},replaceWith:function(a){if(this[0]&&this[0].parentNode){if(f.isFunction(a))return this.each(function(b){var c=f(this),d=c.html();c.replaceWith(a.call(this,b,d))});typeof a!="string"&&(a=f(a).detach());return this.each(function(){var b=this.nextSibling,c=this.parentNode;f(this).remove(),b?f(b).before(a):f(c).append(a)})}return this.length?this.pushStack(f(f.isFunction(a)?a():a),"replaceWith",a):this},detach:function(a){return this.remove(a,!0)},domManip:function(a,c,d){var e,g,h,i,j=a[0],k=[];if(!f.support.checkClone&&arguments.length===3&&typeof j=="string"&&bc.test(j))return this.each(function(){f(this).domManip(a,c,d,!0)});if(f.isFunction(j))return this.each(function(e){var g=f(this);a[0]=j.call(this,e,c?g.html():b),g.domManip(a,c,d)});if(this[0]){i=j&&j.parentNode,f.support.parentNode&&i&&i.nodeType===11&&i.childNodes.length===this.length?e={fragment:i}:e=f.buildFragment(a,this,k),h=e.fragment,h.childNodes.length===1?g=h=h.firstChild:g=h.firstChild;if(g){c=c&&f.nodeName(g,"tr");for(var l=0,m=this.length,n=m-1;l<m;l++)d.call(c?bg(this[l],g):this[l],e.cacheable||m>1&&l<n?f.clone(h,!0,!0):h)}k.length&&f.each(k,bm)}return this}}),f.buildFragment=function(a,b,d){var e,g,h,i;b&&b[0]&&(i=b[0].ownerDocument||b[0]),i.createDocumentFragment||(i=c),a.length===1&&typeof a[0]=="string"&&a[0].length<512&&i===c&&a[0].charAt(0)==="<"&&!bb.test(a[0])&&(f.support.checkClone||!bc.test(a[0]))&&(g=!0,h=f.fragments[a[0]],h&&h!==1&&(e=h)),e||(e=i.createDocumentFragment(),f.clean(a,i,e,d)),g&&(f.fragments[a[0]]=h?e:1);return{fragment:e,cacheable:g}},f.fragments={},f.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){f.fn[a]=function(c){var d=[],e=f(c),g=this.length===1&&this[0].parentNode;if(g&&g.nodeType===11&&g.childNodes.length===1&&e.length===1){e[b](this[0]);return this}for(var h=0,i=e.length;h<i;h++){var j=(h>0?this.clone(!0):this).get();f(e[h])[b](j),d=d.concat(j
+)}return this.pushStack(d,a,e.selector)}}),f.extend({clone:function(a,b,c){var d=a.cloneNode(!0),e,g,h;if((!f.support.noCloneEvent||!f.support.noCloneChecked)&&(a.nodeType===1||a.nodeType===11)&&!f.isXMLDoc(a)){bi(a,d),e=bj(a),g=bj(d);for(h=0;e[h];++h)bi(e[h],g[h])}if(b){bh(a,d);if(c){e=bj(a),g=bj(d);for(h=0;e[h];++h)bh(e[h],g[h])}}e=g=null;return d},clean:function(a,b,d,e){var g;b=b||c,typeof b.createElement=="undefined"&&(b=b.ownerDocument||b[0]&&b[0].ownerDocument||c);var h=[],i;for(var j=0,k;(k=a[j])!=null;j++){typeof k=="number"&&(k+="");if(!k)continue;if(typeof k=="string")if(!ba.test(k))k=b.createTextNode(k);else{k=k.replace(Z,"<$1></$2>");var l=($.exec(k)||["",""])[1].toLowerCase(),m=bf[l]||bf._default,n=m[0],o=b.createElement("div");o.innerHTML=m[1]+k+m[2];while(n--)o=o.lastChild;if(!f.support.tbody){var p=_.test(k),q=l==="table"&&!p?o.firstChild&&o.firstChild.childNodes:m[1]==="<table>"&&!p?o.childNodes:[];for(i=q.length-1;i>=0;--i)f.nodeName(q[i],"tbody")&&!q[i].childNodes.length&&q[i].parentNode.removeChild(q[i])}!f.support.leadingWhitespace&&Y.test(k)&&o.insertBefore(b.createTextNode(Y.exec(k)[0]),o.firstChild),k=o.childNodes}var r;if(!f.support.appendChecked)if(k[0]&&typeof (r=k.length)=="number")for(i=0;i<r;i++)bl(k[i]);else bl(k);k.nodeType?h.push(k):h=f.merge(h,k)}if(d){g=function(a){return!a.type||bd.test(a.type)};for(j=0;h[j];j++)if(e&&f.nodeName(h[j],"script")&&(!h[j].type||h[j].type.toLowerCase()==="text/javascript"))e.push(h[j].parentNode?h[j].parentNode.removeChild(h[j]):h[j]);else{if(h[j].nodeType===1){var s=f.grep(h[j].getElementsByTagName("script"),g);h.splice.apply(h,[j+1,0].concat(s))}d.appendChild(h[j])}}return h},cleanData:function(a){var b,c,d=f.cache,e=f.expando,g=f.event.special,h=f.support.deleteExpando;for(var i=0,j;(j=a[i])!=null;i++){if(j.nodeName&&f.noData[j.nodeName.toLowerCase()])continue;c=j[f.expando];if(c){b=d[c]&&d[c][e];if(b&&b.events){for(var k in b.events)g[k]?f.event.remove(j,k):f.removeEvent(j,k,b.handle);b.handle&&(b.handle.elem=null)}h?delete j[f.expando]:j.removeAttribute&&j.removeAttribute(f.expando),delete d[c]}}}});var bn=/alpha\([^)]*\)/i,bo=/opacity=([^)]*)/,bp=/([A-Z]|^ms)/g,bq=/^-?\d+(?:px)?$/i,br=/^-?\d/,bs=/^[+\-]=/,bt=/[^+\-\.\de]+/g,bu={position:"absolute",visibility:"hidden",display:"block"},bv=["Left","Right"],bw=["Top","Bottom"],bx,by,bz;f.fn.css=function(a,c){if(arguments.length===2&&c===b)return this;return f.access(this,a,c,!0,function(a,c,d){return d!==b?f.style(a,c,d):f.css(a,c)})},f.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=bx(a,"opacity","opacity");return c===""?"1":c}return a.style.opacity}}},cssNumber:{fillOpacity:!0,fontWeight:!0,lineHeight:!0,opacity:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":f.support.cssFloat?"cssFloat":"styleFloat"},style:function(a,c,d,e){if(!!a&&a.nodeType!==3&&a.nodeType!==8&&!!a.style){var g,h,i=f.camelCase(c),j=a.style,k=f.cssHooks[i];c=f.cssProps[i]||i;if(d===b){if(k&&"get"in k&&(g=k.get(a,!1,e))!==b)return g;return j[c]}h=typeof d;if(h==="number"&&isNaN(d)||d==null)return;h==="string"&&bs.test(d)&&(d=+d.replace(bt,"")+parseFloat(f.css(a,c)),h="number"),h==="number"&&!f.cssNumber[i]&&(d+="px");if(!k||!("set"in k)||(d=k.set(a,d))!==b)try{j[c]=d}catch(l){}}},css:function(a,c,d){var e,g;c=f.camelCase(c),g=f.cssHooks[c],c=f.cssProps[c]||c,c==="cssFloat"&&(c="float");if(g&&"get"in g&&(e=g.get(a,!0,d))!==b)return e;if(bx)return bx(a,c)},swap:function(a,b,c){var d={};for(var e in b)d[e]=a.style[e],a.style[e]=b[e];c.call(a);for(e in b)a.style[e]=d[e]}}),f.curCSS=f.css,f.each(["height","width"],function(a,b){f.cssHooks[b]={get:function(a,c,d){var e;if(c){if(a.offsetWidth!==0)return bA(a,b,d);f.swap(a,bu,function(){e=bA(a,b,d)});return e}},set:function(a,b){if(!bq.test(b))return b;b=parseFloat(b);if(b>=0)return b+"px"}}}),f.support.opacity||(f.cssHooks.opacity={get:function(a,b){return bo.test((b&&a.currentStyle?a.currentStyle.filter:a.style.filter)||"")?parseFloat(RegExp.$1)/100+"":b?"1":""},set:function(a,b){var c=a.style,d=a.currentStyle;c.zoom=1;var e=f.isNaN(b)?"":"alpha(opacity="+b*100+")",g=d&&d.filter||c.filter||"";c.filter=bn.test(g)?g.replace(bn,e):g+" "+e}}),f(function(){f.support.reliableMarginRight||(f.cssHooks.marginRight={get:function(a,b){var c;f.swap(a,{display:"inline-block"},function(){b?c=bx(a,"margin-right","marginRight"):c=a.style.marginRight});return c}})}),c.defaultView&&c.defaultView.getComputedStyle&&(by=function(a,c){var d,e,g;c=c.replace(bp,"-$1").toLowerCase();if(!(e=a.ownerDocument.defaultView))return b;if(g=e.getComputedStyle(a,null))d=g.getPropertyValue(c),d===""&&!f.contains(a.ownerDocument.documentElement,a)&&(d=f.style(a,c));return d}),c.documentElement.currentStyle&&(bz=function(a,b){var c,d=a.currentStyle&&a.currentStyle[b],e=a.runtimeStyle&&a.runtimeStyle[b],f=a.style;!bq.test(d)&&br.test(d)&&(c=f.left,e&&(a.runtimeStyle.left=a.currentStyle.left),f.left=b==="fontSize"?"1em":d||0,d=f.pixelLeft+"px",f.left=c,e&&(a.runtimeStyle.left=e));return d===""?"auto":d}),bx=by||bz,f.expr&&f.expr.filters&&(f.expr.filters.hidden=function(a){var b=a.offsetWidth,c=a.offsetHeight;return b===0&&c===0||!f.support.reliableHiddenOffsets&&(a.style.display||f.css(a,"display"))==="none"},f.expr.filters.visible=function(a){return!f.expr.filters.hidden(a)});var bB=/%20/g,bC=/\[\]$/,bD=/\r?\n/g,bE=/#.*$/,bF=/^(.*?):[ \t]*([^\r\n]*)\r?$/mg,bG=/^(?:color|date|datetime|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i,bH=/^(?:about|app|app\-storage|.+\-extension|file|widget):$/,bI=/^(?:GET|HEAD)$/,bJ=/^\/\//,bK=/\?/,bL=/<script\b[^<]*(?:(?!<\/script>)<[^<]*)*<\/script>/gi,bM=/^(?:select|textarea)/i,bN=/\s+/,bO=/([?&])_=[^&]*/,bP=/^([\w\+\.\-]+:)(?:\/\/([^\/?#:]*)(?::(\d+))?)?/,bQ=f.fn.load,bR={},bS={},bT,bU;try{bT=e.href}catch(bV){bT=c.createElement("a"),bT.href="",bT=bT.href}bU=bP.exec(bT.toLowerCase())||[],f.fn.extend({load:function(a,c,d){if(typeof a!="string"&&bQ)return bQ.apply(this,arguments);if(!this.length)return this;var e=a.indexOf(" ");if(e>=0){var g=a.slice(e,a.length);a=a.slice(0,e)}var h="GET";c&&(f.isFunction(c)?(d=c,c=b):typeof c=="object"&&(c=f.param(c,f.ajaxSettings.traditional),h="POST"));var i=this;f.ajax({url:a,type:h,dataType:"html",data:c,complete:function(a,b,c){c=a.responseText,a.isResolved()&&(a.done(function(a){c=a}),i.html(g?f("<div>").append(c.replace(bL,"")).find(g):c)),d&&i.each(d,[c,b,a])}});return this},serialize:function(){return f.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?f.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||bM.test(this.nodeName)||bG.test(this.type))}).map(function(a,b){var c=f(this).val();return c==null?null:f.isArray(c)?f.map(c,function(a,c){return{name:b.name,value:a.replace(bD,"\r\n")}}):{name:b.name,value:c.replace(bD,"\r\n")}}).get()}}),f.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "),function(a,b){f.fn[b]=function(a){return this.bind(b,a)}}),f.each(["get","post"],function(a,c){f[c]=function(a,d,e,g){f.isFunction(d)&&(g=g||e,e=d,d=b);return f.ajax({type:c,url:a,data:d,success:e,dataType:g})}}),f.extend({getScript:function(a,c){return f.get(a,b,c,"script")},getJSON:function(a,b,c){return f.get(a,b,c,"json")},ajaxSetup:function(a,b){b?f.extend(!0,a,f.ajaxSettings,b):(b=a,a=f.extend(!0,f.ajaxSettings,b));for(var c in{context:1,url:1})c in b?a[c]=b[c]:c in f.ajaxSettings&&(a[c]=f.ajaxSettings[c]);return a},ajaxSettings:{url:bT,isLocal:bH.test(bU[1]),global:!0,type:"GET",contentType:"application/x-www-form-urlencoded",processData:!0,async:!0,accepts:{xml:"application/xml, text/xml",html:"text/html",text:"text/plain",json:"application/json, text/javascript","*":"*/*"},contents:{xml:/xml/,html:/html/,json:/json/},responseFields:{xml:"responseXML",text:"responseText"},converters:{"* text":a.String,"text html":!0,"text json":f.parseJSON,"text xml":f.parseXML}},ajaxPrefilter:bW(bR),ajaxTransport:bW(bS),ajax:function(a,c){function w(a,c,l,m){if(s!==2){s=2,q&&clearTimeout(q),p=b,n=m||"",v.readyState=a?4:0;var o,r,u,w=l?bZ(d,v,l):b,x,y;if(a>=200&&a<300||a===304){if(d.ifModified){if(x=v.getResponseHeader("Last-Modified"))f.lastModified[k]=x;if(y=v.getResponseHeader("Etag"))f.etag[k]=y}if(a===304)c="notmodified",o=!0;else try{r=b$(d,w),c="success",o=!0}catch(z){c="parsererror",u=z}}else{u=c;if(!c||a)c="error",a<0&&(a=0)}v.status=a,v.statusText=c,o?h.resolveWith(e,[r,c,v]):h.rejectWith(e,[v,c,u]),v.statusCode(j),j=b,t&&g.trigger("ajax"+(o?"Success":"Error"),[v,d,o?r:u]),i.resolveWith(e,[v,c]),t&&(g.trigger("ajaxComplete",[v,d]),--f.active||f.event.trigger("ajaxStop"))}}typeof a=="object"&&(c=a,a=b),c=c||{};var d=f.ajaxSetup({},c),e=d.context||d,g=e!==d&&(e.nodeType||e instanceof f)?f(e):f.event,h=f.Deferred(),i=f._Deferred(),j=d.statusCode||{},k,l={},m={},n,o,p,q,r,s=0,t,u,v={readyState:0,setRequestHeader:function(a,b){if(!s){var c=a.toLowerCase();a=m[c]=m[c]||a,l[a]=b}return this},getAllResponseHeaders:function(){return s===2?n:null},getResponseHeader:function(a){var c;if(s===2){if(!o){o={};while(c=bF.exec(n))o[c[1].toLowerCase()]=c[2]}c=o[a.toLowerCase()]}return c===b?null:c},overrideMimeType:function(a){s||(d.mimeType=a);return this},abort:function(a){a=a||"abort",p&&p.abort(a),w(0,a);return this}};h.promise(v),v.success=v.done,v.error=v.fail,v.complete=i.done,v.statusCode=function(a){if(a){var b;if(s<2)for(b in a)j[b]=[j[b],a[b]];else b=a[v.status],v.then(b,b)}return this},d.url=((a||d.url)+"").replace(bE,"").replace(bJ,bU[1]+"//"),d.dataTypes=f.trim(d.dataType||"*").toLowerCase().split(bN),d.crossDomain==null&&(r=bP.exec(d.url.toLowerCase()),d.crossDomain=!(!r||r[1]==bU[1]&&r[2]==bU[2]&&(r[3]||(r[1]==="http:"?80:443))==(bU[3]||(bU[1]==="http:"?80:443)))),d.data&&d.processData&&typeof d.data!="string"&&(d.data=f.param(d.data,d.traditional)),bX(bR,d,c,v);if(s===2)return!1;t=d.global,d.type=d.type.toUpperCase(),d.hasContent=!bI.test(d.type),t&&f.active++===0&&f.event.trigger("ajaxStart");if(!d.hasContent){d.data&&(d.url+=(bK.test(d.url)?"&":"?")+d.data),k=d.url;if(d.cache===!1){var x=f.now(),y=d.url.replace(bO,"$1_="+x);d.url=y+(y===d.url?(bK.test(d.url)?"&":"?")+"_="+x:"")}}(d.data&&d.hasContent&&d.contentType!==!1||c.contentType)&&v.setRequestHeader("Content-Type",d.contentType),d.ifModified&&(k=k||d.url,f.lastModified[k]&&v.setRequestHeader("If-Modified-Since",f.lastModified[k]),f.etag[k]&&v.setRequestHeader("If-None-Match",f.etag[k])),v.setRequestHeader("Accept",d.dataTypes[0]&&d.accepts[d.dataTypes[0]]?d.accepts[d.dataTypes[0]]+(d.dataTypes[0]!=="*"?", */*; q=0.01":""):d.accepts["*"]);for(u in d.headers)v.setRequestHeader(u,d.headers[u]);if(d.beforeSend&&(d.beforeSend.call(e,v,d)===!1||s===2)){v.abort();return!1}for(u in{success:1,error:1,complete:1})v[u](d[u]);p=bX(bS,d,c,v);if(!p)w(-1,"No Transport");else{v.readyState=1,t&&g.trigger("ajaxSend",[v,d]),d.async&&d.timeout>0&&(q=setTimeout(function(){v.abort("timeout")},d.timeout));try{s=1,p.send(l,w)}catch(z){status<2?w(-1,z):f.error(z)}}return v},param:function(a,c){var d=[],e=function(a,b){b=f.isFunction(b)?b():b,d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(b)};c===b&&(c=f.ajaxSettings.traditional);if(f.isArray(a)||a.jquery&&!f.isPlainObject(a))f.each(a,function(){e(this.name,this.value)});else for(var g in a)bY(g,a[g],c,e);return d.join("&").replace(bB,"+")}}),f.extend({active:0,lastModified:{},etag:{}});var b_=f.now(),ca=/(\=)\?(&|$)|\?\?/i;f.ajaxSetup({jsonp:"callback",jsonpCallback:function(){return f.expando+"_"+b_++}}),f.ajaxPrefilter("json jsonp",function(b,c,d){var e=b.contentType==="application/x-www-form-urlencoded"&&typeof b.data=="string";if(b.dataTypes[0]==="jsonp"||b.jsonp!==!1&&(ca.test(b.url)||e&&ca.test(b.data))){var g,h=b.jsonpCallback=f.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,i=a[h],j=b.url,k=b.data,l="$1"+h+"$2";b.jsonp!==!1&&(j=j.replace(ca,l),b.url===j&&(e&&(k=k.replace(ca,l)),b.data===k&&(j+=(/\?/.test(j)?"&":"?")+b.jsonp+"="+h))),b.url=j,b.data=k,a[h]=function(a){g=[a]},d.always(function(){a[h]=i,g&&f.isFunction(i)&&a[h](g[0])}),b.converters["script json"]=function(){g||f.error(h+" was not called");return g[0]},b.dataTypes[0]="json";return"script"}}),f.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/javascript|ecmascript/},converters:{"text script":function(a){f.globalEval(a);return a}}}),f.ajaxPrefilter("script",function(a){a.cache===b&&(a.cache=!1),a.crossDomain&&(a.type="GET",a.global=!1)}),f.ajaxTransport("script",function(a){if(a.crossDomain){var d,e=c.head||c.getElementsByTagName("head")[0]||c.documentElement;return{send:function(f,g){d=c.createElement("script"),d.async="async",a.scriptCharset&&(d.charset=a.scriptCharset),d.src=a.url,d.onload=d.onreadystatechange=function(a,c){if(c||!d.readyState||/loaded|complete/.test(d.readyState))d.onload=d.onreadystatechange=null,e&&d.parentNode&&e.removeChild(d),d=b,c||g(200,"success")},e.insertBefore(d,e.firstChild)},abort:function(){d&&d.onload(0,1)}}}});var cb=a.ActiveXObject?function(){for(var a in cd)cd[a](0,1)}:!1,cc=0,cd;f.ajaxSettings.xhr=a.ActiveXObject?function(){return!this.isLocal&&ce()||cf()}:ce,function(a){f.extend(f.support,{ajax:!!a,cors:!!a&&"withCredentials"in a})}(f.ajaxSettings.xhr()),f.support.ajax&&f.ajaxTransport(function(c){if(!c.crossDomain||f.support.cors){var d;return{send:function(e,g){var h=c.xhr(),i,j;c.username?h.open(c.type,c.url,c.async,c.username,c.password):h.open(c.type,c.url,c.async);if(c.xhrFields)for(j in c.xhrFields)h[j]=c.xhrFields[j];c.mimeType&&h.overrideMimeType&&h.overrideMimeType(c.mimeType),!c.crossDomain&&!e["X-Requested-With"]&&(e["X-Requested-With"]="XMLHttpRequest");try{for(j in e)h.setRequestHeader(j,e[j])}catch(k){}h.send(c.hasContent&&c.data||null),d=function(a,e){var j,k,l,m,n;try{if(d&&(e||h.readyState===4)){d=b,i&&(h.onreadystatechange=f.noop,cb&&delete cd[i]);if(e)h.readyState!==4&&h.abort();else{j=h.status,l=h.getAllResponseHeaders(),m={},n=h.responseXML,n&&n.documentElement&&(m.xml=n),m.text=h.responseText;try{k=h.statusText}catch(o){k=""}!j&&c.isLocal&&!c.crossDomain?j=m.text?200:404:j===1223&&(j=204)}}}catch(p){e||g(-1,p)}m&&g(j,k,m,l)},!c.async||h.readyState===4?d():(i=++cc,cb&&(cd||(cd={},f(a).unload(cb)),cd[i]=d),h.onreadystatechange=d)},abort:function(){d&&d(0,1)}}}});var cg={},ch,ci,cj=/^(?:toggle|show|hide)$/,ck=/^([+\-]=)?([\d+.\-]+)([a-z%]*)$/i,cl,cm=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]],cn,co=a.webkitRequestAnimationFrame||a.mozRequestAnimationFrame||a.oRequestAnimationFrame;f.fn.extend({show:function(a,b,c){var d,e;if(a||a===0)return this.animate(cr("show",3),a,b,c);for(var g=0,h=this.length;g<h;g++)d=this[g],d.style&&(e=d.style.display,!f._data(d,"olddisplay")&&e==="none"&&(e=d.style.display=""),e===""&&f.css(d,"display")==="none"&&f._data(d,"olddisplay",cs(d.nodeName)));for(g=0;g<h;g++){d=this[g];if(d.style){e=d.style.display;if(e===""||e==="none")d.style.display=f._data(d,"olddisplay")||""}}return this},hide:function(a,b,c){if(a||a===0)return this.animate(cr("hide",3),a,b,c);for(var d=0,e=this.length;d<e;d++)if(this[d].style){var g=f.css(this[d],"display");g!=="none"&&!f._data(this[d],"olddisplay")&&f._data(this[d],"olddisplay",g)}for(d=0;d<e;d++)this[d].style&&(this[d].style.display="none");return this},_toggle:f.fn.toggle,toggle:function(a,b,c){var d=typeof a=="boolean";f.isFunction(a)&&f.isFunction(b)?this._toggle.apply(this,arguments):a==null||d?this.each(function(){var b=d?a:f(this).is(":hidden");f(this)[b?"show":"hide"]()}):this.animate(cr("toggle",3),a,b,c);return this},fadeTo:function(a,b,c,d){return this.filter(":hidden").css("opacity",0).show().end().animate({opacity:b},a,c,d)},animate:function(a,b,c,d){var e=f.speed(b,c,d);if(f.isEmptyObject(a))return this.each(e.complete,[!1]);a=f.extend({},a);return this[e.queue===!1?"each":"queue"](function(){e.queue===!1&&f._mark(this);var b=f.extend({},e),c=this.nodeType===1,d=c&&f(this).is(":hidden"),g,h,i,j,k,l,m,n,o;b.animatedProperties={};for(i in a){g=f.camelCase(i),i!==g&&(a[g]=a[i],delete a[i]),h=a[g],f.isArray(h)?(b.animatedProperties[g]=h[1],h=a[g]=h[0]):b.animatedProperties[g]=b.specialEasing&&b.specialEasing[g]||b.easing||"swing";if(h==="hide"&&d||h==="show"&&!d)return b.complete.call(this);c&&(g==="height"||g==="width")&&(b.overflow=[this.style.overflow,this.style.overflowX,this.style.overflowY],f.css(this,"display")==="inline"&&f.css(this,"float")==="none"&&(f.support.inlineBlockNeedsLayout?(j=cs(this.nodeName),j==="inline"?this.style.display="inline-block":(this.style.display="inline",this.style.zoom=1)):this.style.display="inline-block"))}b.overflow!=null&&(this.style.overflow="hidden");for(i in a)k=new f.fx(this,b,i),h=a[i],cj.test(h)?k[h==="toggle"?d?"show":"hide":h]():(l=ck.exec(h),m=k.cur(),l?(n=parseFloat(l[2]),o=l[3]||(f.cssNumber[i]?"":"px"),o!=="px"&&(f.style(this,i,(n||1)+o),m=(n||1)/k.cur()*m,f.style(this,i,m+o)),l[1]&&(n=(l[1]==="-="?-1:1)*n+m),k.custom(m,n,o)):k.custom(m,h,""));return!0})},stop:function(a,b){a&&this.queue([]),this.each(function(){var a=f.timers,c=a.length;b||f._unmark(!0,this);while(c--)a[c].elem===this&&(b&&a[c](!0),a.splice(c,1))}),b||this.dequeue();return this}}),f.each({slideDown:cr("show",1),slideUp:cr("hide",1),slideToggle:cr("toggle",1),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(a,b){f.fn[a]=function(a,c,d){return this.animate(b,a,c,d)}}),f.extend({speed:function(a,b,c){var d=a&&typeof a=="object"?f.extend({},a):{complete:c||!c&&b||f.isFunction(a)&&a,duration:a,easing:c&&b||b&&!f.isFunction(b)&&b};d.duration=f.fx.off?0:typeof d.duration=="number"?d.duration:d.duration in f.fx.speeds?f.fx.speeds[d.duration]:f.fx.speeds._default,d.old=d.complete,d.complete=function(a){f.isFunction(d.old)&&d.old.call(this),d.queue!==!1?f.dequeue(this):a!==!1&&f._unmark(this)};return d},easing:{linear:function(a,b,c,d){return c+d*a},swing:function(a,b,c,d){return(-Math.cos(a*Math.PI)/2+.5)*d+c}},timers:[],fx:function(a,b,c){this.options=b,this.elem=a,this.prop=c,b.orig=b.orig||{}}}),f.fx.prototype={update:function(){this.options.step&&this.options.step.call(this.elem,this.now,this),(f.fx.step[this.prop]||f.fx.step._default)(this)},cur:function(){if(this.elem[this.prop]!=null&&(!this.elem.style||this.elem.style[this.prop]==null))return this.elem[this.prop];var a,b=f.css(this.elem,this.prop);return isNaN(a=parseFloat(b))?!b||b==="auto"?0:b:a},custom:function(a,b,c){function h(a){return d.step(a)}var d=this,e=f.fx,g;this.startTime=cn||cp(),this.start=a,this.end=b,this.unit=c||this.unit||(f.cssNumber[this.prop]?"":"px"),this.now=this.start,this.pos=this.state=0,h.elem=this.elem,h()&&f.timers.push(h)&&!cl&&(co?(cl=!0,g=function(){cl&&(co(g),e.tick())},co(g)):cl=setInterval(e.tick,e.interval))},show:function(){this.options.orig[this.prop]=f.style(this.elem,this.prop),this.options.show=!0,this.custom(this.prop==="width"||this.prop==="height"?1:0,this.cur()),f(this.elem).show()},hide:function(){this.options.orig[this.prop]=f.style(this.elem,this.prop),this.options.hide=!0,this.custom(this.cur(),0)},step:function(a){var b=cn||cp(),c=!0,d=this.elem,e=this.options,g,h;if(a||b>=e.duration+this.startTime){this.now=this.end,this.pos=this.state=1,this.update(),e.animatedProperties[this.prop]=!0;for(g in e.animatedProperties)e.animatedProperties[g]!==!0&&(c=!1);if(c){e.overflow!=null&&!f.support.shrinkWrapBlocks&&f.each(["","X","Y"],function(a,b){d.style["overflow"+b]=e.overflow[a]}),e.hide&&f(d).hide();if(e.hide||e.show)for(var i in e.animatedProperties)f.style(d,i,e.orig[i]);e.complete.call(d)}return!1}e.duration==Infinity?this.now=b:(h=b-this.startTime,this.state=h/e.duration,this.pos=f.easing[e.animatedProperties[this.prop]](this.state,h,0,1,e.duration),this.now=this.start+(this.end-this.start)*this.pos),this.update();return!0}},f.extend(f.fx,{tick:function(){for(var a=f.timers,b=0;b<a.length;++b)a[b]()||a.splice(b--,1);a.length||f.fx.stop()},interval:13,stop:function(){clearInterval(cl),cl=null},speeds:{slow:600,fast:200,_default:400},step:{opacity:function(a){f.style(a.elem,"opacity",a.now)},_default:function(a){a.elem.style&&a.elem.style[a.prop]!=null?a.elem.style[a.prop]=(a.prop==="width"||a.prop==="height"?Math.max(0,a.now):a.now)+a.unit:a.elem[a.prop]=a.now}}}),f.expr&&f.expr.filters&&(f.expr.filters.animated=function(a){return f.grep(f.timers,function(b){return a===b.elem}).length});var ct=/^t(?:able|d|h)$/i,cu=/^(?:body|html)$/i;"getBoundingClientRect"in c.documentElement?f.fn.offset=function(a){var b=this[0],c;if(a)return this.each(function(b){f.offset.setOffset(this,a,b)});if(!b||!b.ownerDocument)return null;if(b===b.ownerDocument.body)return f.offset.bodyOffset(b);try{c=b.getBoundingClientRect()}catch(d){}var e=b.ownerDocument,g=e.documentElement;if(!c||!f.contains(g,b))return c?{top:c.top,left:c.left}:{top:0,left:0};var h=e.body,i=cv(e),j=g.clientTop||h.clientTop||0,k=g.clientLeft||h.clientLeft||0,l=i.pageYOffset||f.support.boxModel&&g.scrollTop||h.scrollTop,m=i.pageXOffset||f.support.boxModel&&g.scrollLeft||h.scrollLeft,n=c.top+l-j,o=c.left+m-k;return{top:n,left:o}}:f.fn.offset=function(a){var b=this[0];if(a)return this.each(function(b){f.offset.setOffset(this,a,b)});if(!b||!b.ownerDocument)return null;if(b===b.ownerDocument.body)return f.offset.bodyOffset(b);f.offset.initialize();var c,d=b.offsetParent,e=b,g=b.ownerDocument,h=g.documentElement,i=g.body,j=g.defaultView,k=j?j.getComputedStyle(b,null):b.currentStyle,l=b.offsetTop,m=b.offsetLeft;while((b=b.parentNode)&&b!==i&&b!==h){if(f.offset.supportsFixedPosition&&k.position==="fixed")break;c=j?j.getComputedStyle(b,null):b.currentStyle,l-=b.scrollTop,m-=b.scrollLeft,b===d&&(l+=b.offsetTop,m+=b.offsetLeft,f.offset.doesNotAddBorder&&(!f.offset.doesAddBorderForTableAndCells||!ct.test(b.nodeName))&&(l+=parseFloat(c.borderTopWidth)||0,m+=parseFloat(c.borderLeftWidth)||0),e=d,d=b.offsetParent),f.offset.subtractsBorderForOverflowNotVisible&&c.overflow!=="visible"&&(l+=parseFloat(c.borderTopWidth)||0,m+=parseFloat(c.borderLeftWidth)||0),k=c}if(k.position==="relative"||k.position==="static")l+=i.offsetTop,m+=i.offsetLeft;f.offset.supportsFixedPosition&&k.position==="fixed"&&(l+=Math.max(h.scrollTop,i.scrollTop),m+=Math.max(h.scrollLeft,i.scrollLeft));return{top:l,left:m}},f.offset={initialize:function(){var a=c.body,b=c.createElement("div"),d,e,g,h,i=parseFloat(f.css(a,"marginTop"))||0,j="<div style='position:absolute;top:0;left:0;margin:0;border:5px solid #000;padding:0;width:1px;height:1px;'><div></div></div><table style='position:absolute;top:0;left:0;margin:0;border:5px solid #000;padding:0;width:1px;height:1px;' cellpadding='0' cellspacing='0'><tr><td></td></tr></table>";f.extend(b.style,{position:"absolute",top:0,left:0,margin:0,border:0,width:"1px",height:"1px",visibility:"hidden"}),b.innerHTML=j,a.insertBefore(b,a.firstChild),d=b.firstChild,e=d.firstChild,h=d.nextSibling.firstChild.firstChild,this.doesNotAddBorder=e.offsetTop!==5,this.doesAddBorderForTableAndCells=h.offsetTop===5,e.style.position="fixed",e.style.top="20px",this.supportsFixedPosition=e.offsetTop===20||e.offsetTop===15,e.style.position=e.style.top="",d.style.overflow="hidden",d.style.position="relative",this.subtractsBorderForOverflowNotVisible=e.offsetTop===-5,this.doesNotIncludeMarginInBodyOffset=a.offsetTop!==i,a.removeChild(b),f.offset.initialize=f.noop},bodyOffset:function(a){var b=a.offsetTop,c=a.offsetLeft;f.offset.initialize(),f.offset.doesNotIncludeMarginInBodyOffset&&(b+=parseFloat(f.css(a,"marginTop"))||0,c+=parseFloat(f.css(a,"marginLeft"))||0);return{top:b,left:c}},setOffset:function(a,b,c){var d=f.css(a,"position");d==="static"&&(a.style.position="relative");var e=f(a),g=e.offset(),h=f.css(a,"top"),i=f.css(a,"left"),j=(d==="absolute"||d==="fixed")&&f.inArray("auto",[h,i])>-1,k={},l={},m,n;j?(l=e.position(),m=l.top,n=l.left):(m=parseFloat(h)||0,n=parseFloat(i)||0),f.isFunction(b)&&(b=b.call(a,c,g)),b.top!=null&&(k.top=b.top-g.top+m),b.left!=null&&(k.left=b.left-g.left+n),"using"in b?b.using.call(a,k):e.css(k)}},f.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),c=this.offset(),d=cu.test(b[0].nodeName)?{top:0,left:0}:b.offset();c.top-=parseFloat(f.css(a,"marginTop"))||0,c.left-=parseFloat(f.css(a,"marginLeft"))||0,d.top+=parseFloat(f.css(b[0],"borderTopWidth"))||0,d.left+=parseFloat(f.css(b[0],"borderLeftWidth"))||0;return{top:c.top-d.top,left:c.left-d.left}},offsetParent:function(){return this.map(function(){var a=this.offsetParent||c.body;while(a&&!cu.test(a.nodeName)&&f.css(a,"position")==="static")a=a.offsetParent;return a})}}),f.each(["Left","Top"],function(a,c){var d="scroll"+c;f.fn[d]=function(c){var e,g;if(c===b){e=this[0];if(!e)return null;g=cv(e);return g?"pageXOffset"in g?g[a?"pageYOffset":"pageXOffset"]:f.support.boxModel&&g.document.documentElement[d]||g.document.body[d]:e[d]}return this.each(function(){g=cv(this),g?g.scrollTo(a?f(g).scrollLeft():c,a?c:f(g).scrollTop()):this[d]=c})}}),f.each(["Height","Width"],function(a,c){var d=c.toLowerCase();f.fn["inner"+c]=function(){var a=this[0];return a&&a.style?parseFloat(f.css(a,d,"padding")):null},f.fn["outer"+c]=function(a){var b=this[0];return b&&b.style?parseFloat(f.css(b,d,a?"margin":"border")):null},f.fn[d]=function(a){var e=this[0];if(!e)return a==null?null:this;if(f.isFunction(a))return this.each(function(b){var c=f(this);c[d](a.call(this,b,c[d]()))});if(f.isWindow(e)){var g=e.document.documentElement["client"+c];return e.document.compatMode==="CSS1Compat"&&g||e.document.body["client"+c]||g}if(e.nodeType===9)return Math.max(e.documentElement["client"+c],e.body["scroll"+c],e.documentElement["scroll"+c],e.body["offset"+c],e.documentElement["offset"+c]);if(a===b){var h=f.css(e,d),i=parseFloat(h);return f.isNaN(i)?h:i}return this.css(d,typeof a=="string"?a:a+"px")}}),a.jQuery=a.$=f})(window);
\ No newline at end of file
diff --git a/collects/meta/drdr/static/jquery.flot.js b/collects/meta/drdr/static/jquery.flot.js
new file mode 100644
index 0000000000..aabc544e9a
--- /dev/null
+++ b/collects/meta/drdr/static/jquery.flot.js
@@ -0,0 +1,2599 @@
+/*! Javascript plotting library for jQuery, v. 0.7.
+ *
+ * Released under the MIT license by IOLA, December 2007.
+ *
+ */
+
+// first an inline dependency, jquery.colorhelpers.js, we inline it here
+// for convenience
+
+/* Plugin for jQuery for working with colors.
+ * 
+ * Version 1.1.
+ * 
+ * Inspiration from jQuery color animation plugin by John Resig.
+ *
+ * Released under the MIT license by Ole Laursen, October 2009.
+ *
+ * Examples:
+ *
+ *   $.color.parse("#fff").scale('rgb', 0.25).add('a', -0.5).toString()
+ *   var c = $.color.extract($("#mydiv"), 'background-color');
+ *   console.log(c.r, c.g, c.b, c.a);
+ *   $.color.make(100, 50, 25, 0.4).toString() // returns "rgba(100,50,25,0.4)"
+ *
+ * Note that .scale() and .add() return the same modified object
+ * instead of making a new one.
+ *
+ * V. 1.1: Fix error handling so e.g. parsing an empty string does
+ * produce a color rather than just crashing.
+ */ 
+(function(B){B.color={};B.color.make=function(F,E,C,D){var G={};G.r=F||0;G.g=E||0;G.b=C||0;G.a=D!=null?D:1;G.add=function(J,I){for(var H=0;H<J.length;++H){G[J.charAt(H)]+=I}return G.normalize()};G.scale=function(J,I){for(var H=0;H<J.length;++H){G[J.charAt(H)]*=I}return G.normalize()};G.toString=function(){if(G.a>=1){return"rgb("+[G.r,G.g,G.b].join(",")+")"}else{return"rgba("+[G.r,G.g,G.b,G.a].join(",")+")"}};G.normalize=function(){function H(J,K,I){return K<J?J:(K>I?I:K)}G.r=H(0,parseInt(G.r),255);G.g=H(0,parseInt(G.g),255);G.b=H(0,parseInt(G.b),255);G.a=H(0,G.a,1);return G};G.clone=function(){return B.color.make(G.r,G.b,G.g,G.a)};return G.normalize()};B.color.extract=function(D,C){var E;do{E=D.css(C).toLowerCase();if(E!=""&&E!="transparent"){break}D=D.parent()}while(!B.nodeName(D.get(0),"body"));if(E=="rgba(0, 0, 0, 0)"){E="transparent"}return B.color.parse(E)};B.color.parse=function(F){var E,C=B.color.make;if(E=/rgb\(\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*\)/.exec(F)){return C(parseInt(E[1],10),parseInt(E[2],10),parseInt(E[3],10))}if(E=/rgba\(\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]+(?:\.[0-9]+)?)\s*\)/.exec(F)){return C(parseInt(E[1],10),parseInt(E[2],10),parseInt(E[3],10),parseFloat(E[4]))}if(E=/rgb\(\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*\)/.exec(F)){return C(parseFloat(E[1])*2.55,parseFloat(E[2])*2.55,parseFloat(E[3])*2.55)}if(E=/rgba\(\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\s*\)/.exec(F)){return C(parseFloat(E[1])*2.55,parseFloat(E[2])*2.55,parseFloat(E[3])*2.55,parseFloat(E[4]))}if(E=/#([a-fA-F0-9]{2})([a-fA-F0-9]{2})([a-fA-F0-9]{2})/.exec(F)){return C(parseInt(E[1],16),parseInt(E[2],16),parseInt(E[3],16))}if(E=/#([a-fA-F0-9])([a-fA-F0-9])([a-fA-F0-9])/.exec(F)){return C(parseInt(E[1]+E[1],16),parseInt(E[2]+E[2],16),parseInt(E[3]+E[3],16))}var D=B.trim(F).toLowerCase();if(D=="transparent"){return C(255,255,255,0)}else{E=A[D]||[0,0,0];return C(E[0],E[1],E[2])}};var A={aqua:[0,255,255],azure:[240,255,255],beige:[245,245,220],black:[0,0,0],blue:[0,0,255],brown:[165,42,42],cyan:[0,255,255],darkblue:[0,0,139],darkcyan:[0,139,139],darkgrey:[169,169,169],darkgreen:[0,100,0],darkkhaki:[189,183,107],darkmagenta:[139,0,139],darkolivegreen:[85,107,47],darkorange:[255,140,0],darkorchid:[153,50,204],darkred:[139,0,0],darksalmon:[233,150,122],darkviolet:[148,0,211],fuchsia:[255,0,255],gold:[255,215,0],green:[0,128,0],indigo:[75,0,130],khaki:[240,230,140],lightblue:[173,216,230],lightcyan:[224,255,255],lightgreen:[144,238,144],lightgrey:[211,211,211],lightpink:[255,182,193],lightyellow:[255,255,224],lime:[0,255,0],magenta:[255,0,255],maroon:[128,0,0],navy:[0,0,128],olive:[128,128,0],orange:[255,165,0],pink:[255,192,203],purple:[128,0,128],violet:[128,0,128],red:[255,0,0],silver:[192,192,192],white:[255,255,255],yellow:[255,255,0]}})(jQuery);
+
+// the actual Flot code
+(function($) {
+    function Plot(placeholder, data_, options_, plugins) {
+        // data is on the form:
+        //   [ series1, series2 ... ]
+        // where series is either just the data as [ [x1, y1], [x2, y2], ... ]
+        // or { data: [ [x1, y1], [x2, y2], ... ], label: "some label", ... }
+        
+        var series = [],
+            options = {
+                // the color theme used for graphs
+                colors: ["#edc240", "#afd8f8", "#cb4b4b", "#4da74d", "#9440ed"],
+                legend: {
+                    show: true,
+                    noColumns: 1, // number of colums in legend table
+                    labelFormatter: null, // fn: string -> string
+                    labelBoxBorderColor: "#ccc", // border color for the little label boxes
+                    container: null, // container (as jQuery object) to put legend in, null means default on top of graph
+                    position: "ne", // position of default legend container within plot
+                    margin: 5, // distance from grid edge to default legend container within plot
+                    backgroundColor: null, // null means auto-detect
+                    backgroundOpacity: 0.85 // set to 0 to avoid background
+                },
+                xaxis: {
+                    show: null, // null = auto-detect, true = always, false = never
+                    position: "bottom", // or "top"
+                    mode: null, // null or "time"
+                    color: null, // base color, labels, ticks
+                    tickColor: null, // possibly different color of ticks, e.g. "rgba(0,0,0,0.15)"
+                    transform: null, // null or f: number -> number to transform axis
+                    inverseTransform: null, // if transform is set, this should be the inverse function
+                    min: null, // min. value to show, null means set automatically
+                    max: null, // max. value to show, null means set automatically
+                    autoscaleMargin: null, // margin in % to add if auto-setting min/max
+                    ticks: null, // either [1, 3] or [[1, "a"], 3] or (fn: axis info -> ticks) or app. number of ticks for auto-ticks
+                    tickFormatter: null, // fn: number -> string
+                    labelWidth: null, // size of tick labels in pixels
+                    labelHeight: null,
+                    reserveSpace: null, // whether to reserve space even if axis isn't shown
+                    tickLength: null, // size in pixels of ticks, or "full" for whole line
+                    alignTicksWithAxis: null, // axis number or null for no sync
+                    
+                    // mode specific options
+                    tickDecimals: null, // no. of decimals, null means auto
+                    tickSize: null, // number or [number, "unit"]
+                    minTickSize: null, // number or [number, "unit"]
+                    monthNames: null, // list of names of months
+                    timeformat: null, // format string to use
+                    twelveHourClock: false // 12 or 24 time in time mode
+                },
+                yaxis: {
+                    autoscaleMargin: 0.02,
+                    position: "left" // or "right"
+                },
+                xaxes: [],
+                yaxes: [],
+                series: {
+                    points: {
+                        show: false,
+                        radius: 3,
+                        lineWidth: 2, // in pixels
+                        fill: true,
+                        fillColor: "#ffffff",
+                        symbol: "circle" // or callback
+                    },
+                    lines: {
+                        // we don't put in show: false so we can see
+                        // whether lines were actively disabled 
+                        lineWidth: 2, // in pixels
+                        fill: false,
+                        fillColor: null,
+                        steps: false
+                    },
+                    bars: {
+                        show: false,
+                        lineWidth: 2, // in pixels
+                        barWidth: 1, // in units of the x axis
+                        fill: true,
+                        fillColor: null,
+                        align: "left", // or "center" 
+                        horizontal: false
+                    },
+                    shadowSize: 3
+                },
+                grid: {
+                    show: true,
+                    aboveData: false,
+                    color: "#545454", // primary color used for outline and labels
+                    backgroundColor: null, // null for transparent, else color
+                    borderColor: null, // set if different from the grid color
+                    tickColor: null, // color for the ticks, e.g. "rgba(0,0,0,0.15)"
+                    labelMargin: 5, // in pixels
+                    axisMargin: 8, // in pixels
+                    borderWidth: 2, // in pixels
+                    minBorderMargin: null, // in pixels, null means taken from points radius
+                    markings: null, // array of ranges or fn: axes -> array of ranges
+                    markingsColor: "#f4f4f4",
+                    markingsLineWidth: 2,
+                    // interactive stuff
+                    clickable: false,
+                    hoverable: false,
+                    autoHighlight: true, // highlight in case mouse is near
+                    mouseActiveRadius: 10 // how far the mouse can be away to activate an item
+                },
+                hooks: {}
+            },
+        canvas = null,      // the canvas for the plot itself
+        overlay = null,     // canvas for interactive stuff on top of plot
+        eventHolder = null, // jQuery object that events should be bound to
+        ctx = null, octx = null,
+        xaxes = [], yaxes = [],
+        plotOffset = { left: 0, right: 0, top: 0, bottom: 0},
+        canvasWidth = 0, canvasHeight = 0,
+        plotWidth = 0, plotHeight = 0,
+        hooks = {
+            processOptions: [],
+            processRawData: [],
+            processDatapoints: [],
+            drawSeries: [],
+            draw: [],
+            bindEvents: [],
+            drawOverlay: [],
+            shutdown: []
+        },
+        plot = this;
+
+        // public functions
+        plot.setData = setData;
+        plot.setupGrid = setupGrid;
+        plot.draw = draw;
+        plot.getPlaceholder = function() { return placeholder; };
+        plot.getCanvas = function() { return canvas; };
+        plot.getPlotOffset = function() { return plotOffset; };
+        plot.width = function () { return plotWidth; };
+        plot.height = function () { return plotHeight; };
+        plot.offset = function () {
+            var o = eventHolder.offset();
+            o.left += plotOffset.left;
+            o.top += plotOffset.top;
+            return o;
+        };
+        plot.getData = function () { return series; };
+        plot.getAxes = function () {
+            var res = {}, i;
+            $.each(xaxes.concat(yaxes), function (_, axis) {
+                if (axis)
+                    res[axis.direction + (axis.n != 1 ? axis.n : "") + "axis"] = axis;
+            });
+            return res;
+        };
+        plot.getXAxes = function () { return xaxes; };
+        plot.getYAxes = function () { return yaxes; };
+        plot.c2p = canvasToAxisCoords;
+        plot.p2c = axisToCanvasCoords;
+        plot.getOptions = function () { return options; };
+        plot.highlight = highlight;
+        plot.unhighlight = unhighlight;
+        plot.triggerRedrawOverlay = triggerRedrawOverlay;
+        plot.pointOffset = function(point) {
+            return {
+                left: parseInt(xaxes[axisNumber(point, "x") - 1].p2c(+point.x) + plotOffset.left),
+                top: parseInt(yaxes[axisNumber(point, "y") - 1].p2c(+point.y) + plotOffset.top)
+            };
+        };
+        plot.shutdown = shutdown;
+        plot.resize = function () {
+            getCanvasDimensions();
+            resizeCanvas(canvas);
+            resizeCanvas(overlay);
+        };
+
+        // public attributes
+        plot.hooks = hooks;
+        
+        // initialize
+        initPlugins(plot);
+        parseOptions(options_);
+        setupCanvases();
+        setData(data_);
+        setupGrid();
+        draw();
+        bindEvents();
+
+
+        function executeHooks(hook, args) {
+            args = [plot].concat(args);
+            for (var i = 0; i < hook.length; ++i)
+                hook[i].apply(this, args);
+        }
+
+        function initPlugins() {
+            for (var i = 0; i < plugins.length; ++i) {
+                var p = plugins[i];
+                p.init(plot);
+                if (p.options)
+                    $.extend(true, options, p.options);
+            }
+        }
+        
+        function parseOptions(opts) {
+            var i;
+            
+            $.extend(true, options, opts);
+            
+            if (options.xaxis.color == null)
+                options.xaxis.color = options.grid.color;
+            if (options.yaxis.color == null)
+                options.yaxis.color = options.grid.color;
+            
+            if (options.xaxis.tickColor == null) // backwards-compatibility
+                options.xaxis.tickColor = options.grid.tickColor;
+            if (options.yaxis.tickColor == null) // backwards-compatibility
+                options.yaxis.tickColor = options.grid.tickColor;
+
+            if (options.grid.borderColor == null)
+                options.grid.borderColor = options.grid.color;
+            if (options.grid.tickColor == null)
+                options.grid.tickColor = $.color.parse(options.grid.color).scale('a', 0.22).toString();
+            
+            // fill in defaults in axes, copy at least always the
+            // first as the rest of the code assumes it'll be there
+            for (i = 0; i < Math.max(1, options.xaxes.length); ++i)
+                options.xaxes[i] = $.extend(true, {}, options.xaxis, options.xaxes[i]);
+            for (i = 0; i < Math.max(1, options.yaxes.length); ++i)
+                options.yaxes[i] = $.extend(true, {}, options.yaxis, options.yaxes[i]);
+
+            // backwards compatibility, to be removed in future
+            if (options.xaxis.noTicks && options.xaxis.ticks == null)
+                options.xaxis.ticks = options.xaxis.noTicks;
+            if (options.yaxis.noTicks && options.yaxis.ticks == null)
+                options.yaxis.ticks = options.yaxis.noTicks;
+            if (options.x2axis) {
+                options.xaxes[1] = $.extend(true, {}, options.xaxis, options.x2axis);
+                options.xaxes[1].position = "top";
+            }
+            if (options.y2axis) {
+                options.yaxes[1] = $.extend(true, {}, options.yaxis, options.y2axis);
+                options.yaxes[1].position = "right";
+            }
+            if (options.grid.coloredAreas)
+                options.grid.markings = options.grid.coloredAreas;
+            if (options.grid.coloredAreasColor)
+                options.grid.markingsColor = options.grid.coloredAreasColor;
+            if (options.lines)
+                $.extend(true, options.series.lines, options.lines);
+            if (options.points)
+                $.extend(true, options.series.points, options.points);
+            if (options.bars)
+                $.extend(true, options.series.bars, options.bars);
+            if (options.shadowSize != null)
+                options.series.shadowSize = options.shadowSize;
+
+            // save options on axes for future reference
+            for (i = 0; i < options.xaxes.length; ++i)
+                getOrCreateAxis(xaxes, i + 1).options = options.xaxes[i];
+            for (i = 0; i < options.yaxes.length; ++i)
+                getOrCreateAxis(yaxes, i + 1).options = options.yaxes[i];
+
+            // add hooks from options
+            for (var n in hooks)
+                if (options.hooks[n] && options.hooks[n].length)
+                    hooks[n] = hooks[n].concat(options.hooks[n]);
+
+            executeHooks(hooks.processOptions, [options]);
+        }
+
+        function setData(d) {
+            series = parseData(d);
+            fillInSeriesOptions();
+            processData();
+        }
+        
+        function parseData(d) {
+            var res = [];
+            for (var i = 0; i < d.length; ++i) {
+                var s = $.extend(true, {}, options.series);
+
+                if (d[i].data != null) {
+                    s.data = d[i].data; // move the data instead of deep-copy
+                    delete d[i].data;
+
+                    $.extend(true, s, d[i]);
+
+                    d[i].data = s.data;
+                }
+                else
+                    s.data = d[i];
+                res.push(s);
+            }
+
+            return res;
+        }
+        
+        function axisNumber(obj, coord) {
+            var a = obj[coord + "axis"];
+            if (typeof a == "object") // if we got a real axis, extract number
+                a = a.n;
+            if (typeof a != "number")
+                a = 1; // default to first axis
+            return a;
+        }
+
+        function allAxes() {
+            // return flat array without annoying null entries
+            return $.grep(xaxes.concat(yaxes), function (a) { return a; });
+        }
+        
+        function canvasToAxisCoords(pos) {
+            // return an object with x/y corresponding to all used axes 
+            var res = {}, i, axis;
+            for (i = 0; i < xaxes.length; ++i) {
+                axis = xaxes[i];
+                if (axis && axis.used)
+                    res["x" + axis.n] = axis.c2p(pos.left);
+            }
+
+            for (i = 0; i < yaxes.length; ++i) {
+                axis = yaxes[i];
+                if (axis && axis.used)
+                    res["y" + axis.n] = axis.c2p(pos.top);
+            }
+            
+            if (res.x1 !== undefined)
+                res.x = res.x1;
+            if (res.y1 !== undefined)
+                res.y = res.y1;
+
+            return res;
+        }
+        
+        function axisToCanvasCoords(pos) {
+            // get canvas coords from the first pair of x/y found in pos
+            var res = {}, i, axis, key;
+
+            for (i = 0; i < xaxes.length; ++i) {
+                axis = xaxes[i];
+                if (axis && axis.used) {
+                    key = "x" + axis.n;
+                    if (pos[key] == null && axis.n == 1)
+                        key = "x";
+
+                    if (pos[key] != null) {
+                        res.left = axis.p2c(pos[key]);
+                        break;
+                    }
+                }
+            }
+            
+            for (i = 0; i < yaxes.length; ++i) {
+                axis = yaxes[i];
+                if (axis && axis.used) {
+                    key = "y" + axis.n;
+                    if (pos[key] == null && axis.n == 1)
+                        key = "y";
+
+                    if (pos[key] != null) {
+                        res.top = axis.p2c(pos[key]);
+                        break;
+                    }
+                }
+            }
+            
+            return res;
+        }
+        
+        function getOrCreateAxis(axes, number) {
+            if (!axes[number - 1])
+                axes[number - 1] = {
+                    n: number, // save the number for future reference
+                    direction: axes == xaxes ? "x" : "y",
+                    options: $.extend(true, {}, axes == xaxes ? options.xaxis : options.yaxis)
+                };
+                
+            return axes[number - 1];
+        }
+
+        function fillInSeriesOptions() {
+            var i;
+            
+            // collect what we already got of colors
+            var neededColors = series.length,
+                usedColors = [],
+                assignedColors = [];
+            for (i = 0; i < series.length; ++i) {
+                var sc = series[i].color;
+                if (sc != null) {
+                    --neededColors;
+                    if (typeof sc == "number")
+                        assignedColors.push(sc);
+                    else
+                        usedColors.push($.color.parse(series[i].color));
+                }
+            }
+            
+            // we might need to generate more colors if higher indices
+            // are assigned
+            for (i = 0; i < assignedColors.length; ++i) {
+                neededColors = Math.max(neededColors, assignedColors[i] + 1);
+            }
+
+            // produce colors as needed
+            var colors = [], variation = 0;
+            i = 0;
+            while (colors.length < neededColors) {
+                var c;
+                if (options.colors.length == i) // check degenerate case
+                    c = $.color.make(100, 100, 100);
+                else
+                    c = $.color.parse(options.colors[i]);
+
+                // vary color if needed
+                var sign = variation % 2 == 1 ? -1 : 1;
+                c.scale('rgb', 1 + sign * Math.ceil(variation / 2) * 0.2)
+
+                // FIXME: if we're getting to close to something else,
+                // we should probably skip this one
+                colors.push(c);
+                
+                ++i;
+                if (i >= options.colors.length) {
+                    i = 0;
+                    ++variation;
+                }
+            }
+
+            // fill in the options
+            var colori = 0, s;
+            for (i = 0; i < series.length; ++i) {
+                s = series[i];
+                
+                // assign colors
+                if (s.color == null) {
+                    s.color = colors[colori].toString();
+                    ++colori;
+                }
+                else if (typeof s.color == "number")
+                    s.color = colors[s.color].toString();
+
+                // turn on lines automatically in case nothing is set
+                if (s.lines.show == null) {
+                    var v, show = true;
+                    for (v in s)
+                        if (s[v] && s[v].show) {
+                            show = false;
+                            break;
+                        }
+                    if (show)
+                        s.lines.show = true;
+                }
+
+                // setup axes
+                s.xaxis = getOrCreateAxis(xaxes, axisNumber(s, "x"));
+                s.yaxis = getOrCreateAxis(yaxes, axisNumber(s, "y"));
+            }
+        }
+        
+        function processData() {
+            var topSentry = Number.POSITIVE_INFINITY,
+                bottomSentry = Number.NEGATIVE_INFINITY,
+                fakeInfinity = Number.MAX_VALUE,
+                i, j, k, m, length,
+                s, points, ps, x, y, axis, val, f, p;
+
+            function updateAxis(axis, min, max) {
+                if (min < axis.datamin && min != -fakeInfinity)
+                    axis.datamin = min;
+                if (max > axis.datamax && max != fakeInfinity)
+                    axis.datamax = max;
+            }
+
+            $.each(allAxes(), function (_, axis) {
+                // init axis
+                axis.datamin = topSentry;
+                axis.datamax = bottomSentry;
+                axis.used = false;
+            });
+            
+            for (i = 0; i < series.length; ++i) {
+                s = series[i];
+                s.datapoints = { points: [] };
+                
+                executeHooks(hooks.processRawData, [ s, s.data, s.datapoints ]);
+            }
+            
+            // first pass: clean and copy data
+            for (i = 0; i < series.length; ++i) {
+                s = series[i];
+
+                var data = s.data, format = s.datapoints.format;
+
+                if (!format) {
+                    format = [];
+                    // find out how to copy
+                    format.push({ x: true, number: true, required: true });
+                    format.push({ y: true, number: true, required: true });
+
+                    if (s.bars.show || (s.lines.show && s.lines.fill)) {
+                        format.push({ y: true, number: true, required: false, defaultValue: 0 });
+                        if (s.bars.horizontal) {
+                            delete format[format.length - 1].y;
+                            format[format.length - 1].x = true;
+                        }
+                    }
+                    
+                    s.datapoints.format = format;
+                }
+
+                if (s.datapoints.pointsize != null)
+                    continue; // already filled in
+
+                s.datapoints.pointsize = format.length;
+                
+                ps = s.datapoints.pointsize;
+                points = s.datapoints.points;
+
+                insertSteps = s.lines.show && s.lines.steps;
+                s.xaxis.used = s.yaxis.used = true;
+                
+                for (j = k = 0; j < data.length; ++j, k += ps) {
+                    p = data[j];
+
+                    var nullify = p == null;
+                    if (!nullify) {
+                        for (m = 0; m < ps; ++m) {
+                            val = p[m];
+                            f = format[m];
+
+                            if (f) {
+                                if (f.number && val != null) {
+                                    val = +val; // convert to number
+                                    if (isNaN(val))
+                                        val = null;
+                                    else if (val == Infinity)
+                                        val = fakeInfinity;
+                                    else if (val == -Infinity)
+                                        val = -fakeInfinity;
+                                }
+
+                                if (val == null) {
+                                    if (f.required)
+                                        nullify = true;
+                                    
+                                    if (f.defaultValue != null)
+                                        val = f.defaultValue;
+                                }
+                            }
+                            
+                            points[k + m] = val;
+                        }
+                    }
+                    
+                    if (nullify) {
+                        for (m = 0; m < ps; ++m) {
+                            val = points[k + m];
+                            if (val != null) {
+                                f = format[m];
+                                // extract min/max info
+                                if (f.x)
+                                    updateAxis(s.xaxis, val, val);
+                                if (f.y)
+                                    updateAxis(s.yaxis, val, val);
+                            }
+                            points[k + m] = null;
+                        }
+                    }
+                    else {
+                        // a little bit of line specific stuff that
+                        // perhaps shouldn't be here, but lacking
+                        // better means...
+                        if (insertSteps && k > 0
+                            && points[k - ps] != null
+                            && points[k - ps] != points[k]
+                            && points[k - ps + 1] != points[k + 1]) {
+                            // copy the point to make room for a middle point
+                            for (m = 0; m < ps; ++m)
+                                points[k + ps + m] = points[k + m];
+
+                            // middle point has same y
+                            points[k + 1] = points[k - ps + 1];
+
+                            // we've added a point, better reflect that
+                            k += ps;
+                        }
+                    }
+                }
+            }
+
+            // give the hooks a chance to run
+            for (i = 0; i < series.length; ++i) {
+                s = series[i];
+                
+                executeHooks(hooks.processDatapoints, [ s, s.datapoints]);
+            }
+
+            // second pass: find datamax/datamin for auto-scaling
+            for (i = 0; i < series.length; ++i) {
+                s = series[i];
+                points = s.datapoints.points,
+                ps = s.datapoints.pointsize;
+
+                var xmin = topSentry, ymin = topSentry,
+                    xmax = bottomSentry, ymax = bottomSentry;
+                
+                for (j = 0; j < points.length; j += ps) {
+                    if (points[j] == null)
+                        continue;
+
+                    for (m = 0; m < ps; ++m) {
+                        val = points[j + m];
+                        f = format[m];
+                        if (!f || val == fakeInfinity || val == -fakeInfinity)
+                            continue;
+                        
+                        if (f.x) {
+                            if (val < xmin)
+                                xmin = val;
+                            if (val > xmax)
+                                xmax = val;
+                        }
+                        if (f.y) {
+                            if (val < ymin)
+                                ymin = val;
+                            if (val > ymax)
+                                ymax = val;
+                        }
+                    }
+                }
+                
+                if (s.bars.show) {
+                    // make sure we got room for the bar on the dancing floor
+                    var delta = s.bars.align == "left" ? 0 : -s.bars.barWidth/2;
+                    if (s.bars.horizontal) {
+                        ymin += delta;
+                        ymax += delta + s.bars.barWidth;
+                    }
+                    else {
+                        xmin += delta;
+                        xmax += delta + s.bars.barWidth;
+                    }
+                }
+                
+                updateAxis(s.xaxis, xmin, xmax);
+                updateAxis(s.yaxis, ymin, ymax);
+            }
+
+            $.each(allAxes(), function (_, axis) {
+                if (axis.datamin == topSentry)
+                    axis.datamin = null;
+                if (axis.datamax == bottomSentry)
+                    axis.datamax = null;
+            });
+        }
+
+        function makeCanvas(skipPositioning, cls) {
+            var c = document.createElement('canvas');
+            c.className = cls;
+            c.width = canvasWidth;
+            c.height = canvasHeight;
+                    
+            if (!skipPositioning)
+                $(c).css({ position: 'absolute', left: 0, top: 0 });
+                
+            $(c).appendTo(placeholder);
+                
+            if (!c.getContext) // excanvas hack
+                c = window.G_vmlCanvasManager.initElement(c);
+
+            // used for resetting in case we get replotted
+            c.getContext("2d").save();
+            
+            return c;
+        }
+
+        function getCanvasDimensions() {
+            canvasWidth = placeholder.width();
+            canvasHeight = placeholder.height();
+            
+            if (canvasWidth <= 0 || canvasHeight <= 0)
+                throw "Invalid dimensions for plot, width = " + canvasWidth + ", height = " + canvasHeight;
+        }
+
+        function resizeCanvas(c) {
+            // resizing should reset the state (excanvas seems to be
+            // buggy though)
+            if (c.width != canvasWidth)
+                c.width = canvasWidth;
+
+            if (c.height != canvasHeight)
+                c.height = canvasHeight;
+
+            // so try to get back to the initial state (even if it's
+            // gone now, this should be safe according to the spec)
+            var cctx = c.getContext("2d");
+            cctx.restore();
+
+            // and save again
+            cctx.save();
+        }
+        
+        function setupCanvases() {
+            var reused,
+                existingCanvas = placeholder.children("canvas.base"),
+                existingOverlay = placeholder.children("canvas.overlay");
+
+            if (existingCanvas.length == 0 || existingOverlay == 0) {
+                // init everything
+                
+                placeholder.html(""); // make sure placeholder is clear
+            
+                placeholder.css({ padding: 0 }); // padding messes up the positioning
+                
+                if (placeholder.css("position") == 'static')
+                    placeholder.css("position", "relative"); // for positioning labels and overlay
+
+                getCanvasDimensions();
+                
+                canvas = makeCanvas(true, "base");
+                overlay = makeCanvas(false, "overlay"); // overlay canvas for interactive features
+
+                reused = false;
+            }
+            else {
+                // reuse existing elements
+
+                canvas = existingCanvas.get(0);
+                overlay = existingOverlay.get(0);
+
+                reused = true;
+            }
+
+            ctx = canvas.getContext("2d");
+            octx = overlay.getContext("2d");
+
+            // we include the canvas in the event holder too, because IE 7
+            // sometimes has trouble with the stacking order
+            eventHolder = $([overlay, canvas]);
+
+            if (reused) {
+                // run shutdown in the old plot object
+                placeholder.data("plot").shutdown();
+
+                // reset reused canvases
+                plot.resize();
+                
+                // make sure overlay pixels are cleared (canvas is cleared when we redraw)
+                octx.clearRect(0, 0, canvasWidth, canvasHeight);
+                
+                // then whack any remaining obvious garbage left
+                eventHolder.unbind();
+                placeholder.children().not([canvas, overlay]).remove();
+            }
+
+            // save in case we get replotted
+            placeholder.data("plot", plot);
+        }
+
+        function bindEvents() {
+            // bind events
+            if (options.grid.hoverable) {
+                eventHolder.mousemove(onMouseMove);
+                eventHolder.mouseleave(onMouseLeave);
+            }
+
+            if (options.grid.clickable)
+                eventHolder.click(onClick);
+
+            executeHooks(hooks.bindEvents, [eventHolder]);
+        }
+
+        function shutdown() {
+            if (redrawTimeout)
+                clearTimeout(redrawTimeout);
+            
+            eventHolder.unbind("mousemove", onMouseMove);
+            eventHolder.unbind("mouseleave", onMouseLeave);
+            eventHolder.unbind("click", onClick);
+            
+            executeHooks(hooks.shutdown, [eventHolder]);
+        }
+
+        function setTransformationHelpers(axis) {
+            // set helper functions on the axis, assumes plot area
+            // has been computed already
+            
+            function identity(x) { return x; }
+            
+            var s, m, t = axis.options.transform || identity,
+                it = axis.options.inverseTransform;
+            
+            // precompute how much the axis is scaling a point
+            // in canvas space
+            if (axis.direction == "x") {
+                s = axis.scale = plotWidth / Math.abs(t(axis.max) - t(axis.min));
+                m = Math.min(t(axis.max), t(axis.min));
+            }
+            else {
+                s = axis.scale = plotHeight / Math.abs(t(axis.max) - t(axis.min));
+                s = -s;
+                m = Math.max(t(axis.max), t(axis.min));
+            }
+
+            // data point to canvas coordinate
+            if (t == identity) // slight optimization
+                axis.p2c = function (p) { return (p - m) * s; };
+            else
+                axis.p2c = function (p) { return (t(p) - m) * s; };
+            // canvas coordinate to data point
+            if (!it)
+                axis.c2p = function (c) { return m + c / s; };
+            else
+                axis.c2p = function (c) { return it(m + c / s); };
+        }
+
+        function measureTickLabels(axis) {
+            var opts = axis.options, i, ticks = axis.ticks || [], labels = [],
+                l, w = opts.labelWidth, h = opts.labelHeight, dummyDiv;
+
+            function makeDummyDiv(labels, width) {
+                return $('<div style="position:absolute;top:-10000px;' + width + 'font-size:smaller">' +
+                         '<div class="' + axis.direction + 'Axis ' + axis.direction + axis.n + 'Axis">'
+                         + labels.join("") + '</div></div>')
+                    .appendTo(placeholder);
+            }
+            
+            if (axis.direction == "x") {
+                // to avoid measuring the widths of the labels (it's slow), we
+                // construct fixed-size boxes and put the labels inside
+                // them, we don't need the exact figures and the
+                // fixed-size box content is easy to center
+                if (w == null)
+                    w = Math.floor(canvasWidth / (ticks.length > 0 ? ticks.length : 1));
+
+                // measure x label heights
+                if (h == null) {
+                    labels = [];
+                    for (i = 0; i < ticks.length; ++i) {
+                        l = ticks[i].label;
+                        if (l)
+                            labels.push('<div class="tickLabel" style="float:left;width:' + w + 'px">' + l + '</div>');
+                    }
+
+                    if (labels.length > 0) {
+                        // stick them all in the same div and measure
+                        // collective height
+                        labels.push('<div style="clear:left"></div>');
+                        dummyDiv = makeDummyDiv(labels, "width:10000px;");
+                        h = dummyDiv.height();
+                        dummyDiv.remove();
+                    }
+                }
+            }
+            else if (w == null || h == null) {
+                // calculate y label dimensions
+                for (i = 0; i < ticks.length; ++i) {
+                    l = ticks[i].label;
+                    if (l)
+                        labels.push('<div class="tickLabel">' + l + '</div>');
+                }
+                
+                if (labels.length > 0) {
+                    dummyDiv = makeDummyDiv(labels, "");
+                    if (w == null)
+                        w = dummyDiv.children().width();
+                    if (h == null)
+                        h = dummyDiv.find("div.tickLabel").height();
+                    dummyDiv.remove();
+                }
+            }
+
+            if (w == null)
+                w = 0;
+            if (h == null)
+                h = 0;
+
+            axis.labelWidth = w;
+            axis.labelHeight = h;
+        }
+
+        function allocateAxisBoxFirstPhase(axis) {
+            // find the bounding box of the axis by looking at label
+            // widths/heights and ticks, make room by diminishing the
+            // plotOffset
+
+            var lw = axis.labelWidth,
+                lh = axis.labelHeight,
+                pos = axis.options.position,
+                tickLength = axis.options.tickLength,
+                axismargin = options.grid.axisMargin,
+                padding = options.grid.labelMargin,
+                all = axis.direction == "x" ? xaxes : yaxes,
+                index;
+
+            // determine axis margin
+            var samePosition = $.grep(all, function (a) {
+                return a && a.options.position == pos && a.reserveSpace;
+            });
+            if ($.inArray(axis, samePosition) == samePosition.length - 1)
+                axismargin = 0; // outermost
+
+            // determine tick length - if we're innermost, we can use "full"
+            if (tickLength == null)
+                tickLength = "full";
+
+            var sameDirection = $.grep(all, function (a) {
+                return a && a.reserveSpace;
+            });
+
+            var innermost = $.inArray(axis, sameDirection) == 0;
+            if (!innermost && tickLength == "full")
+                tickLength = 5;
+                
+            if (!isNaN(+tickLength))
+                padding += +tickLength;
+
+            // compute box
+            if (axis.direction == "x") {
+                lh += padding;
+                
+                if (pos == "bottom") {
+                    plotOffset.bottom += lh + axismargin;
+                    axis.box = { top: canvasHeight - plotOffset.bottom, height: lh };
+                }
+                else {
+                    axis.box = { top: plotOffset.top + axismargin, height: lh };
+                    plotOffset.top += lh + axismargin;
+                }
+            }
+            else {
+                lw += padding;
+                
+                if (pos == "left") {
+                    axis.box = { left: plotOffset.left + axismargin, width: lw };
+                    plotOffset.left += lw + axismargin;
+                }
+                else {
+                    plotOffset.right += lw + axismargin;
+                    axis.box = { left: canvasWidth - plotOffset.right, width: lw };
+                }
+            }
+
+             // save for future reference
+            axis.position = pos;
+            axis.tickLength = tickLength;
+            axis.box.padding = padding;
+            axis.innermost = innermost;
+        }
+
+        function allocateAxisBoxSecondPhase(axis) {
+            // set remaining bounding box coordinates
+            if (axis.direction == "x") {
+                axis.box.left = plotOffset.left;
+                axis.box.width = plotWidth;
+            }
+            else {
+                axis.box.top = plotOffset.top;
+                axis.box.height = plotHeight;
+            }
+        }
+        
+        function setupGrid() {
+            var i, axes = allAxes();
+
+            // first calculate the plot and axis box dimensions
+
+            $.each(axes, function (_, axis) {
+                axis.show = axis.options.show;
+                if (axis.show == null)
+                    axis.show = axis.used; // by default an axis is visible if it's got data
+                
+                axis.reserveSpace = axis.show || axis.options.reserveSpace;
+
+                setRange(axis);
+            });
+
+            allocatedAxes = $.grep(axes, function (axis) { return axis.reserveSpace; });
+
+            plotOffset.left = plotOffset.right = plotOffset.top = plotOffset.bottom = 0;
+            if (options.grid.show) {
+                $.each(allocatedAxes, function (_, axis) {
+                    // make the ticks
+                    setupTickGeneration(axis);
+                    setTicks(axis);
+                    snapRangeToTicks(axis, axis.ticks);
+
+                    // find labelWidth/Height for axis
+                    measureTickLabels(axis);
+                });
+
+                // with all dimensions in house, we can compute the
+                // axis boxes, start from the outside (reverse order)
+                for (i = allocatedAxes.length - 1; i >= 0; --i)
+                    allocateAxisBoxFirstPhase(allocatedAxes[i]);
+
+                // make sure we've got enough space for things that
+                // might stick out
+                var minMargin = options.grid.minBorderMargin;
+                if (minMargin == null) {
+                    minMargin = 0;
+                    for (i = 0; i < series.length; ++i)
+                        minMargin = Math.max(minMargin, series[i].points.radius + series[i].points.lineWidth/2);
+                }
+                    
+                for (var a in plotOffset) {
+                    plotOffset[a] += options.grid.borderWidth;
+                    plotOffset[a] = Math.max(minMargin, plotOffset[a]);
+                }
+            }
+            
+            plotWidth = canvasWidth - plotOffset.left - plotOffset.right;
+            plotHeight = canvasHeight - plotOffset.bottom - plotOffset.top;
+
+            // now we got the proper plotWidth/Height, we can compute the scaling
+            $.each(axes, function (_, axis) {
+                setTransformationHelpers(axis);
+            });
+
+            if (options.grid.show) {
+                $.each(allocatedAxes, function (_, axis) {
+                    allocateAxisBoxSecondPhase(axis);
+                });
+
+                insertAxisLabels();
+            }
+            
+            insertLegend();
+        }
+        
+        function setRange(axis) {
+            var opts = axis.options,
+                min = +(opts.min != null ? opts.min : axis.datamin),
+                max = +(opts.max != null ? opts.max : axis.datamax),
+                delta = max - min;
+
+            if (delta == 0.0) {
+                // degenerate case
+                var widen = max == 0 ? 1 : 0.01;
+
+                if (opts.min == null)
+                    min -= widen;
+                // always widen max if we couldn't widen min to ensure we
+                // don't fall into min == max which doesn't work
+                if (opts.max == null || opts.min != null)
+                    max += widen;
+            }
+            else {
+                // consider autoscaling
+                var margin = opts.autoscaleMargin;
+                if (margin != null) {
+                    if (opts.min == null) {
+                        min -= delta * margin;
+                        // make sure we don't go below zero if all values
+                        // are positive
+                        if (min < 0 && axis.datamin != null && axis.datamin >= 0)
+                            min = 0;
+                    }
+                    if (opts.max == null) {
+                        max += delta * margin;
+                        if (max > 0 && axis.datamax != null && axis.datamax <= 0)
+                            max = 0;
+                    }
+                }
+            }
+            axis.min = min;
+            axis.max = max;
+        }
+
+        function setupTickGeneration(axis) {
+            var opts = axis.options;
+                
+            // estimate number of ticks
+            var noTicks;
+            if (typeof opts.ticks == "number" && opts.ticks > 0)
+                noTicks = opts.ticks;
+            else
+                // heuristic based on the model a*sqrt(x) fitted to
+                // some data points that seemed reasonable
+                noTicks = 0.3 * Math.sqrt(axis.direction == "x" ? canvasWidth : canvasHeight);
+
+            var delta = (axis.max - axis.min) / noTicks,
+                size, generator, unit, formatter, i, magn, norm;
+
+            if (opts.mode == "time") {
+                // pretty handling of time
+                
+                // map of app. size of time units in milliseconds
+                var timeUnitSize = {
+                    "second": 1000,
+                    "minute": 60 * 1000,
+                    "hour": 60 * 60 * 1000,
+                    "day": 24 * 60 * 60 * 1000,
+                    "month": 30 * 24 * 60 * 60 * 1000,
+                    "year": 365.2425 * 24 * 60 * 60 * 1000
+                };
+
+
+                // the allowed tick sizes, after 1 year we use
+                // an integer algorithm
+                var spec = [
+                    [1, "second"], [2, "second"], [5, "second"], [10, "second"],
+                    [30, "second"], 
+                    [1, "minute"], [2, "minute"], [5, "minute"], [10, "minute"],
+                    [30, "minute"], 
+                    [1, "hour"], [2, "hour"], [4, "hour"],
+                    [8, "hour"], [12, "hour"],
+                    [1, "day"], [2, "day"], [3, "day"],
+                    [0.25, "month"], [0.5, "month"], [1, "month"],
+                    [2, "month"], [3, "month"], [6, "month"],
+                    [1, "year"]
+                ];
+
+                var minSize = 0;
+                if (opts.minTickSize != null) {
+                    if (typeof opts.tickSize == "number")
+                        minSize = opts.tickSize;
+                    else
+                        minSize = opts.minTickSize[0] * timeUnitSize[opts.minTickSize[1]];
+                }
+
+                for (var i = 0; i < spec.length - 1; ++i)
+                    if (delta < (spec[i][0] * timeUnitSize[spec[i][1]]
+                                 + spec[i + 1][0] * timeUnitSize[spec[i + 1][1]]) / 2
+                       && spec[i][0] * timeUnitSize[spec[i][1]] >= minSize)
+                        break;
+                size = spec[i][0];
+                unit = spec[i][1];
+                
+                // special-case the possibility of several years
+                if (unit == "year") {
+                    magn = Math.pow(10, Math.floor(Math.log(delta / timeUnitSize.year) / Math.LN10));
+                    norm = (delta / timeUnitSize.year) / magn;
+                    if (norm < 1.5)
+                        size = 1;
+                    else if (norm < 3)
+                        size = 2;
+                    else if (norm < 7.5)
+                        size = 5;
+                    else
+                        size = 10;
+
+                    size *= magn;
+                }
+
+                axis.tickSize = opts.tickSize || [size, unit];
+                
+                generator = function(axis) {
+                    var ticks = [],
+                        tickSize = axis.tickSize[0], unit = axis.tickSize[1],
+                        d = new Date(axis.min);
+                    
+                    var step = tickSize * timeUnitSize[unit];
+
+                    if (unit == "second")
+                        d.setUTCSeconds(floorInBase(d.getUTCSeconds(), tickSize));
+                    if (unit == "minute")
+                        d.setUTCMinutes(floorInBase(d.getUTCMinutes(), tickSize));
+                    if (unit == "hour")
+                        d.setUTCHours(floorInBase(d.getUTCHours(), tickSize));
+                    if (unit == "month")
+                        d.setUTCMonth(floorInBase(d.getUTCMonth(), tickSize));
+                    if (unit == "year")
+                        d.setUTCFullYear(floorInBase(d.getUTCFullYear(), tickSize));
+                    
+                    // reset smaller components
+                    d.setUTCMilliseconds(0);
+                    if (step >= timeUnitSize.minute)
+                        d.setUTCSeconds(0);
+                    if (step >= timeUnitSize.hour)
+                        d.setUTCMinutes(0);
+                    if (step >= timeUnitSize.day)
+                        d.setUTCHours(0);
+                    if (step >= timeUnitSize.day * 4)
+                        d.setUTCDate(1);
+                    if (step >= timeUnitSize.year)
+                        d.setUTCMonth(0);
+
+
+                    var carry = 0, v = Number.NaN, prev;
+                    do {
+                        prev = v;
+                        v = d.getTime();
+                        ticks.push(v);
+                        if (unit == "month") {
+                            if (tickSize < 1) {
+                                // a bit complicated - we'll divide the month
+                                // up but we need to take care of fractions
+                                // so we don't end up in the middle of a day
+                                d.setUTCDate(1);
+                                var start = d.getTime();
+                                d.setUTCMonth(d.getUTCMonth() + 1);
+                                var end = d.getTime();
+                                d.setTime(v + carry * timeUnitSize.hour + (end - start) * tickSize);
+                                carry = d.getUTCHours();
+                                d.setUTCHours(0);
+                            }
+                            else
+                                d.setUTCMonth(d.getUTCMonth() + tickSize);
+                        }
+                        else if (unit == "year") {
+                            d.setUTCFullYear(d.getUTCFullYear() + tickSize);
+                        }
+                        else
+                            d.setTime(v + step);
+                    } while (v < axis.max && v != prev);
+
+                    return ticks;
+                };
+
+                formatter = function (v, axis) {
+                    var d = new Date(v);
+
+                    // first check global format
+                    if (opts.timeformat != null)
+                        return $.plot.formatDate(d, opts.timeformat, opts.monthNames);
+                    
+                    var t = axis.tickSize[0] * timeUnitSize[axis.tickSize[1]];
+                    var span = axis.max - axis.min;
+                    var suffix = (opts.twelveHourClock) ? " %p" : "";
+                    
+                    if (t < timeUnitSize.minute)
+                        fmt = "%h:%M:%S" + suffix;
+                    else if (t < timeUnitSize.day) {
+                        if (span < 2 * timeUnitSize.day)
+                            fmt = "%h:%M" + suffix;
+                        else
+                            fmt = "%b %d %h:%M" + suffix;
+                    }
+                    else if (t < timeUnitSize.month)
+                        fmt = "%b %d";
+                    else if (t < timeUnitSize.year) {
+                        if (span < timeUnitSize.year)
+                            fmt = "%b";
+                        else
+                            fmt = "%b %y";
+                    }
+                    else
+                        fmt = "%y";
+                    
+                    return $.plot.formatDate(d, fmt, opts.monthNames);
+                };
+            }
+            else {
+                // pretty rounding of base-10 numbers
+                var maxDec = opts.tickDecimals;
+                var dec = -Math.floor(Math.log(delta) / Math.LN10);
+                if (maxDec != null && dec > maxDec)
+                    dec = maxDec;
+
+                magn = Math.pow(10, -dec);
+                norm = delta / magn; // norm is between 1.0 and 10.0
+                
+                if (norm < 1.5)
+                    size = 1;
+                else if (norm < 3) {
+                    size = 2;
+                    // special case for 2.5, requires an extra decimal
+                    if (norm > 2.25 && (maxDec == null || dec + 1 <= maxDec)) {
+                        size = 2.5;
+                        ++dec;
+                    }
+                }
+                else if (norm < 7.5)
+                    size = 5;
+                else
+                    size = 10;
+
+                size *= magn;
+                
+                if (opts.minTickSize != null && size < opts.minTickSize)
+                    size = opts.minTickSize;
+
+                axis.tickDecimals = Math.max(0, maxDec != null ? maxDec : dec);
+                axis.tickSize = opts.tickSize || size;
+
+                generator = function (axis) {
+                    var ticks = [];
+
+                    // spew out all possible ticks
+                    var start = floorInBase(axis.min, axis.tickSize),
+                        i = 0, v = Number.NaN, prev;
+                    do {
+                        prev = v;
+                        v = start + i * axis.tickSize;
+                        ticks.push(v);
+                        ++i;
+                    } while (v < axis.max && v != prev);
+                    return ticks;
+                };
+
+                formatter = function (v, axis) {
+                    return v.toFixed(axis.tickDecimals);
+                };
+            }
+
+            if (opts.alignTicksWithAxis != null) {
+                var otherAxis = (axis.direction == "x" ? xaxes : yaxes)[opts.alignTicksWithAxis - 1];
+                if (otherAxis && otherAxis.used && otherAxis != axis) {
+                    // consider snapping min/max to outermost nice ticks
+                    var niceTicks = generator(axis);
+                    if (niceTicks.length > 0) {
+                        if (opts.min == null)
+                            axis.min = Math.min(axis.min, niceTicks[0]);
+                        if (opts.max == null && niceTicks.length > 1)
+                            axis.max = Math.max(axis.max, niceTicks[niceTicks.length - 1]);
+                    }
+                    
+                    generator = function (axis) {
+                        // copy ticks, scaled to this axis
+                        var ticks = [], v, i;
+                        for (i = 0; i < otherAxis.ticks.length; ++i) {
+                            v = (otherAxis.ticks[i].v - otherAxis.min) / (otherAxis.max - otherAxis.min);
+                            v = axis.min + v * (axis.max - axis.min);
+                            ticks.push(v);
+                        }
+                        return ticks;
+                    };
+                    
+                    // we might need an extra decimal since forced
+                    // ticks don't necessarily fit naturally
+                    if (axis.mode != "time" && opts.tickDecimals == null) {
+                        var extraDec = Math.max(0, -Math.floor(Math.log(delta) / Math.LN10) + 1),
+                            ts = generator(axis);
+
+                        // only proceed if the tick interval rounded
+                        // with an extra decimal doesn't give us a
+                        // zero at end
+                        if (!(ts.length > 1 && /\..*0$/.test((ts[1] - ts[0]).toFixed(extraDec))))
+                            axis.tickDecimals = extraDec;
+                    }
+                }
+            }
+
+            axis.tickGenerator = generator;
+            if ($.isFunction(opts.tickFormatter))
+                axis.tickFormatter = function (v, axis) { return "" + opts.tickFormatter(v, axis); };
+            else
+                axis.tickFormatter = formatter;
+        }
+        
+        function setTicks(axis) {
+            var oticks = axis.options.ticks, ticks = [];
+            if (oticks == null || (typeof oticks == "number" && oticks > 0))
+                ticks = axis.tickGenerator(axis);
+            else if (oticks) {
+                if ($.isFunction(oticks))
+                    // generate the ticks
+                    ticks = oticks({ min: axis.min, max: axis.max });
+                else
+                    ticks = oticks;
+            }
+
+            // clean up/labelify the supplied ticks, copy them over
+            var i, v;
+            axis.ticks = [];
+            for (i = 0; i < ticks.length; ++i) {
+                var label = null;
+                var t = ticks[i];
+                if (typeof t == "object") {
+                    v = +t[0];
+                    if (t.length > 1)
+                        label = t[1];
+                }
+                else
+                    v = +t;
+                if (label == null)
+                    label = axis.tickFormatter(v, axis);
+                if (!isNaN(v))
+                    axis.ticks.push({ v: v, label: label });
+            }
+        }
+
+        function snapRangeToTicks(axis, ticks) {
+            if (axis.options.autoscaleMargin && ticks.length > 0) {
+                // snap to ticks
+                if (axis.options.min == null)
+                    axis.min = Math.min(axis.min, ticks[0].v);
+                if (axis.options.max == null && ticks.length > 1)
+                    axis.max = Math.max(axis.max, ticks[ticks.length - 1].v);
+            }
+        }
+      
+        function draw() {
+            ctx.clearRect(0, 0, canvasWidth, canvasHeight);
+
+            var grid = options.grid;
+
+            // draw background, if any
+            if (grid.show && grid.backgroundColor)
+                drawBackground();
+            
+            if (grid.show && !grid.aboveData)
+                drawGrid();
+
+            for (var i = 0; i < series.length; ++i) {
+                executeHooks(hooks.drawSeries, [ctx, series[i]]);
+                drawSeries(series[i]);
+            }
+
+            executeHooks(hooks.draw, [ctx]);
+            
+            if (grid.show && grid.aboveData)
+                drawGrid();
+        }
+
+        function extractRange(ranges, coord) {
+            var axis, from, to, key, axes = allAxes();
+
+            for (i = 0; i < axes.length; ++i) {
+                axis = axes[i];
+                if (axis.direction == coord) {
+                    key = coord + axis.n + "axis";
+                    if (!ranges[key] && axis.n == 1)
+                        key = coord + "axis"; // support x1axis as xaxis
+                    if (ranges[key]) {
+                        from = ranges[key].from;
+                        to = ranges[key].to;
+                        break;
+                    }
+                }
+            }
+
+            // backwards-compat stuff - to be removed in future
+            if (!ranges[key]) {
+                axis = coord == "x" ? xaxes[0] : yaxes[0];
+                from = ranges[coord + "1"];
+                to = ranges[coord + "2"];
+            }
+
+            // auto-reverse as an added bonus
+            if (from != null && to != null && from > to) {
+                var tmp = from;
+                from = to;
+                to = tmp;
+            }
+            
+            return { from: from, to: to, axis: axis };
+        }
+        
+        function drawBackground() {
+            ctx.save();
+            ctx.translate(plotOffset.left, plotOffset.top);
+
+            ctx.fillStyle = getColorOrGradient(options.grid.backgroundColor, plotHeight, 0, "rgba(255, 255, 255, 0)");
+            ctx.fillRect(0, 0, plotWidth, plotHeight);
+            ctx.restore();
+        }
+
+        function drawGrid() {
+            var i;
+            
+            ctx.save();
+            ctx.translate(plotOffset.left, plotOffset.top);
+
+            // draw markings
+            var markings = options.grid.markings;
+            if (markings) {
+                if ($.isFunction(markings)) {
+                    var axes = plot.getAxes();
+                    // xmin etc. is backwards compatibility, to be
+                    // removed in the future
+                    axes.xmin = axes.xaxis.min;
+                    axes.xmax = axes.xaxis.max;
+                    axes.ymin = axes.yaxis.min;
+                    axes.ymax = axes.yaxis.max;
+                    
+                    markings = markings(axes);
+                }
+
+                for (i = 0; i < markings.length; ++i) {
+                    var m = markings[i],
+                        xrange = extractRange(m, "x"),
+                        yrange = extractRange(m, "y");
+
+                    // fill in missing
+                    if (xrange.from == null)
+                        xrange.from = xrange.axis.min;
+                    if (xrange.to == null)
+                        xrange.to = xrange.axis.max;
+                    if (yrange.from == null)
+                        yrange.from = yrange.axis.min;
+                    if (yrange.to == null)
+                        yrange.to = yrange.axis.max;
+
+                    // clip
+                    if (xrange.to < xrange.axis.min || xrange.from > xrange.axis.max ||
+                        yrange.to < yrange.axis.min || yrange.from > yrange.axis.max)
+                        continue;
+
+                    xrange.from = Math.max(xrange.from, xrange.axis.min);
+                    xrange.to = Math.min(xrange.to, xrange.axis.max);
+                    yrange.from = Math.max(yrange.from, yrange.axis.min);
+                    yrange.to = Math.min(yrange.to, yrange.axis.max);
+
+                    if (xrange.from == xrange.to && yrange.from == yrange.to)
+                        continue;
+
+                    // then draw
+                    xrange.from = xrange.axis.p2c(xrange.from);
+                    xrange.to = xrange.axis.p2c(xrange.to);
+                    yrange.from = yrange.axis.p2c(yrange.from);
+                    yrange.to = yrange.axis.p2c(yrange.to);
+                    
+                    if (xrange.from == xrange.to || yrange.from == yrange.to) {
+                        // draw line
+                        ctx.beginPath();
+                        ctx.strokeStyle = m.color || options.grid.markingsColor;
+                        ctx.lineWidth = m.lineWidth || options.grid.markingsLineWidth;
+                        ctx.moveTo(xrange.from, yrange.from);
+                        ctx.lineTo(xrange.to, yrange.to);
+                        ctx.stroke();
+                    }
+                    else {
+                        // fill area
+                        ctx.fillStyle = m.color || options.grid.markingsColor;
+                        ctx.fillRect(xrange.from, yrange.to,
+                                     xrange.to - xrange.from,
+                                     yrange.from - yrange.to);
+                    }
+                }
+            }
+            
+            // draw the ticks
+            var axes = allAxes(), bw = options.grid.borderWidth;
+
+            for (var j = 0; j < axes.length; ++j) {
+                var axis = axes[j], box = axis.box,
+                    t = axis.tickLength, x, y, xoff, yoff;
+                if (!axis.show || axis.ticks.length == 0)
+                    continue
+                
+                ctx.strokeStyle = axis.options.tickColor || $.color.parse(axis.options.color).scale('a', 0.22).toString();
+                ctx.lineWidth = 1;
+
+                // find the edges
+                if (axis.direction == "x") {
+                    x = 0;
+                    if (t == "full")
+                        y = (axis.position == "top" ? 0 : plotHeight);
+                    else
+                        y = box.top - plotOffset.top + (axis.position == "top" ? box.height : 0);
+                }
+                else {
+                    y = 0;
+                    if (t == "full")
+                        x = (axis.position == "left" ? 0 : plotWidth);
+                    else
+                        x = box.left - plotOffset.left + (axis.position == "left" ? box.width : 0);
+                }
+                
+                // draw tick bar
+                if (!axis.innermost) {
+                    ctx.beginPath();
+                    xoff = yoff = 0;
+                    if (axis.direction == "x")
+                        xoff = plotWidth;
+                    else
+                        yoff = plotHeight;
+                    
+                    if (ctx.lineWidth == 1) {
+                        x = Math.floor(x) + 0.5;
+                        y = Math.floor(y) + 0.5;
+                    }
+
+                    ctx.moveTo(x, y);
+                    ctx.lineTo(x + xoff, y + yoff);
+                    ctx.stroke();
+                }
+
+                // draw ticks
+                ctx.beginPath();
+                for (i = 0; i < axis.ticks.length; ++i) {
+                    var v = axis.ticks[i].v;
+                    
+                    xoff = yoff = 0;
+
+                    if (v < axis.min || v > axis.max
+                        // skip those lying on the axes if we got a border
+                        || (t == "full" && bw > 0
+                            && (v == axis.min || v == axis.max)))
+                        continue;
+
+                    if (axis.direction == "x") {
+                        x = axis.p2c(v);
+                        yoff = t == "full" ? -plotHeight : t;
+                        
+                        if (axis.position == "top")
+                            yoff = -yoff;
+                    }
+                    else {
+                        y = axis.p2c(v);
+                        xoff = t == "full" ? -plotWidth : t;
+                        
+                        if (axis.position == "left")
+                            xoff = -xoff;
+                    }
+
+                    if (ctx.lineWidth == 1) {
+                        if (axis.direction == "x")
+                            x = Math.floor(x) + 0.5;
+                        else
+                            y = Math.floor(y) + 0.5;
+                    }
+
+                    ctx.moveTo(x, y);
+                    ctx.lineTo(x + xoff, y + yoff);
+                }
+                
+                ctx.stroke();
+            }
+            
+            
+            // draw border
+            if (bw) {
+                ctx.lineWidth = bw;
+                ctx.strokeStyle = options.grid.borderColor;
+                ctx.strokeRect(-bw/2, -bw/2, plotWidth + bw, plotHeight + bw);
+            }
+
+            ctx.restore();
+        }
+
+        function insertAxisLabels() {
+            placeholder.find(".tickLabels").remove();
+            
+            var html = ['<div class="tickLabels" style="font-size:smaller">'];
+
+            var axes = allAxes();
+            for (var j = 0; j < axes.length; ++j) {
+                var axis = axes[j], box = axis.box;
+                if (!axis.show)
+                    continue;
+                //debug: html.push('<div style="position:absolute;opacity:0.10;background-color:red;left:' + box.left + 'px;top:' + box.top + 'px;width:' + box.width +  'px;height:' + box.height + 'px"></div>')
+                html.push('<div class="' + axis.direction + 'Axis ' + axis.direction + axis.n + 'Axis" style="color:' + axis.options.color + '">');
+                for (var i = 0; i < axis.ticks.length; ++i) {
+                    var tick = axis.ticks[i];
+                    if (!tick.label || tick.v < axis.min || tick.v > axis.max)
+                        continue;
+
+                    var pos = {}, align;
+                    
+                    if (axis.direction == "x") {
+                        align = "center";
+                        pos.left = Math.round(plotOffset.left + axis.p2c(tick.v) - axis.labelWidth/2);
+                        if (axis.position == "bottom")
+                            pos.top = box.top + box.padding;
+                        else
+                            pos.bottom = canvasHeight - (box.top + box.height - box.padding);
+                    }
+                    else {
+                        pos.top = Math.round(plotOffset.top + axis.p2c(tick.v) - axis.labelHeight/2);
+                        if (axis.position == "left") {
+                            pos.right = canvasWidth - (box.left + box.width - box.padding)
+                            align = "right";
+                        }
+                        else {
+                            pos.left = box.left + box.padding;
+                            align = "left";
+                        }
+                    }
+
+                    pos.width = axis.labelWidth;
+
+                    var style = ["position:absolute", "text-align:" + align ];
+                    for (var a in pos)
+                        style.push(a + ":" + pos[a] + "px")
+                    
+                    html.push('<div class="tickLabel" style="' + style.join(';') + '">' + tick.label + '</div>');
+                }
+                html.push('</div>');
+            }
+
+            html.push('</div>');
+
+            placeholder.append(html.join(""));
+        }
+
+        function drawSeries(series) {
+            if (series.lines.show)
+                drawSeriesLines(series);
+            if (series.bars.show)
+                drawSeriesBars(series);
+            if (series.points.show)
+                drawSeriesPoints(series);
+        }
+        
+        function drawSeriesLines(series) {
+            function plotLine(datapoints, xoffset, yoffset, axisx, axisy) {
+                var points = datapoints.points,
+                    ps = datapoints.pointsize,
+                    prevx = null, prevy = null;
+                
+                ctx.beginPath();
+                for (var i = ps; i < points.length; i += ps) {
+                    var x1 = points[i - ps], y1 = points[i - ps + 1],
+                        x2 = points[i], y2 = points[i + 1];
+                    
+                    if (x1 == null || x2 == null)
+                        continue;
+
+                    // clip with ymin
+                    if (y1 <= y2 && y1 < axisy.min) {
+                        if (y2 < axisy.min)
+                            continue;   // line segment is outside
+                        // compute new intersection point
+                        x1 = (axisy.min - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y1 = axisy.min;
+                    }
+                    else if (y2 <= y1 && y2 < axisy.min) {
+                        if (y1 < axisy.min)
+                            continue;
+                        x2 = (axisy.min - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y2 = axisy.min;
+                    }
+
+                    // clip with ymax
+                    if (y1 >= y2 && y1 > axisy.max) {
+                        if (y2 > axisy.max)
+                            continue;
+                        x1 = (axisy.max - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y1 = axisy.max;
+                    }
+                    else if (y2 >= y1 && y2 > axisy.max) {
+                        if (y1 > axisy.max)
+                            continue;
+                        x2 = (axisy.max - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y2 = axisy.max;
+                    }
+
+                    // clip with xmin
+                    if (x1 <= x2 && x1 < axisx.min) {
+                        if (x2 < axisx.min)
+                            continue;
+                        y1 = (axisx.min - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x1 = axisx.min;
+                    }
+                    else if (x2 <= x1 && x2 < axisx.min) {
+                        if (x1 < axisx.min)
+                            continue;
+                        y2 = (axisx.min - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x2 = axisx.min;
+                    }
+
+                    // clip with xmax
+                    if (x1 >= x2 && x1 > axisx.max) {
+                        if (x2 > axisx.max)
+                            continue;
+                        y1 = (axisx.max - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x1 = axisx.max;
+                    }
+                    else if (x2 >= x1 && x2 > axisx.max) {
+                        if (x1 > axisx.max)
+                            continue;
+                        y2 = (axisx.max - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x2 = axisx.max;
+                    }
+
+                    if (x1 != prevx || y1 != prevy)
+                        ctx.moveTo(axisx.p2c(x1) + xoffset, axisy.p2c(y1) + yoffset);
+                    
+                    prevx = x2;
+                    prevy = y2;
+                    ctx.lineTo(axisx.p2c(x2) + xoffset, axisy.p2c(y2) + yoffset);
+                }
+                ctx.stroke();
+            }
+
+            function plotLineArea(datapoints, axisx, axisy) {
+                var points = datapoints.points,
+                    ps = datapoints.pointsize,
+                    bottom = Math.min(Math.max(0, axisy.min), axisy.max),
+                    i = 0, top, areaOpen = false,
+                    ypos = 1, segmentStart = 0, segmentEnd = 0;
+
+                // we process each segment in two turns, first forward
+                // direction to sketch out top, then once we hit the
+                // end we go backwards to sketch the bottom
+                while (true) {
+                    if (ps > 0 && i > points.length + ps)
+                        break;
+
+                    i += ps; // ps is negative if going backwards
+
+                    var x1 = points[i - ps],
+                        y1 = points[i - ps + ypos],
+                        x2 = points[i], y2 = points[i + ypos];
+
+                    if (areaOpen) {
+                        if (ps > 0 && x1 != null && x2 == null) {
+                            // at turning point
+                            segmentEnd = i;
+                            ps = -ps;
+                            ypos = 2;
+                            continue;
+                        }
+
+                        if (ps < 0 && i == segmentStart + ps) {
+                            // done with the reverse sweep
+                            ctx.fill();
+                            areaOpen = false;
+                            ps = -ps;
+                            ypos = 1;
+                            i = segmentStart = segmentEnd + ps;
+                            continue;
+                        }
+                    }
+
+                    if (x1 == null || x2 == null)
+                        continue;
+
+                    // clip x values
+                    
+                    // clip with xmin
+                    if (x1 <= x2 && x1 < axisx.min) {
+                        if (x2 < axisx.min)
+                            continue;
+                        y1 = (axisx.min - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x1 = axisx.min;
+                    }
+                    else if (x2 <= x1 && x2 < axisx.min) {
+                        if (x1 < axisx.min)
+                            continue;
+                        y2 = (axisx.min - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x2 = axisx.min;
+                    }
+
+                    // clip with xmax
+                    if (x1 >= x2 && x1 > axisx.max) {
+                        if (x2 > axisx.max)
+                            continue;
+                        y1 = (axisx.max - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x1 = axisx.max;
+                    }
+                    else if (x2 >= x1 && x2 > axisx.max) {
+                        if (x1 > axisx.max)
+                            continue;
+                        y2 = (axisx.max - x1) / (x2 - x1) * (y2 - y1) + y1;
+                        x2 = axisx.max;
+                    }
+
+                    if (!areaOpen) {
+                        // open area
+                        ctx.beginPath();
+                        ctx.moveTo(axisx.p2c(x1), axisy.p2c(bottom));
+                        areaOpen = true;
+                    }
+                    
+                    // now first check the case where both is outside
+                    if (y1 >= axisy.max && y2 >= axisy.max) {
+                        ctx.lineTo(axisx.p2c(x1), axisy.p2c(axisy.max));
+                        ctx.lineTo(axisx.p2c(x2), axisy.p2c(axisy.max));
+                        continue;
+                    }
+                    else if (y1 <= axisy.min && y2 <= axisy.min) {
+                        ctx.lineTo(axisx.p2c(x1), axisy.p2c(axisy.min));
+                        ctx.lineTo(axisx.p2c(x2), axisy.p2c(axisy.min));
+                        continue;
+                    }
+                    
+                    // else it's a bit more complicated, there might
+                    // be a flat maxed out rectangle first, then a
+                    // triangular cutout or reverse; to find these
+                    // keep track of the current x values
+                    var x1old = x1, x2old = x2;
+
+                    // clip the y values, without shortcutting, we
+                    // go through all cases in turn
+                    
+                    // clip with ymin
+                    if (y1 <= y2 && y1 < axisy.min && y2 >= axisy.min) {
+                        x1 = (axisy.min - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y1 = axisy.min;
+                    }
+                    else if (y2 <= y1 && y2 < axisy.min && y1 >= axisy.min) {
+                        x2 = (axisy.min - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y2 = axisy.min;
+                    }
+
+                    // clip with ymax
+                    if (y1 >= y2 && y1 > axisy.max && y2 <= axisy.max) {
+                        x1 = (axisy.max - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y1 = axisy.max;
+                    }
+                    else if (y2 >= y1 && y2 > axisy.max && y1 <= axisy.max) {
+                        x2 = (axisy.max - y1) / (y2 - y1) * (x2 - x1) + x1;
+                        y2 = axisy.max;
+                    }
+
+                    // if the x value was changed we got a rectangle
+                    // to fill
+                    if (x1 != x1old) {
+                        ctx.lineTo(axisx.p2c(x1old), axisy.p2c(y1));
+                        // it goes to (x1, y1), but we fill that below
+                    }
+                    
+                    // fill triangular section, this sometimes result
+                    // in redundant points if (x1, y1) hasn't changed
+                    // from previous line to, but we just ignore that
+                    ctx.lineTo(axisx.p2c(x1), axisy.p2c(y1));
+                    ctx.lineTo(axisx.p2c(x2), axisy.p2c(y2));
+
+                    // fill the other rectangle if it's there
+                    if (x2 != x2old) {
+                        ctx.lineTo(axisx.p2c(x2), axisy.p2c(y2));
+                        ctx.lineTo(axisx.p2c(x2old), axisy.p2c(y2));
+                    }
+                }
+            }
+
+            ctx.save();
+            ctx.translate(plotOffset.left, plotOffset.top);
+            ctx.lineJoin = "round";
+
+            var lw = series.lines.lineWidth,
+                sw = series.shadowSize;
+            // FIXME: consider another form of shadow when filling is turned on
+            if (lw > 0 && sw > 0) {
+                // draw shadow as a thick and thin line with transparency
+                ctx.lineWidth = sw;
+                ctx.strokeStyle = "rgba(0,0,0,0.1)";
+                // position shadow at angle from the mid of line
+                var angle = Math.PI/18;
+                plotLine(series.datapoints, Math.sin(angle) * (lw/2 + sw/2), Math.cos(angle) * (lw/2 + sw/2), series.xaxis, series.yaxis);
+                ctx.lineWidth = sw/2;
+                plotLine(series.datapoints, Math.sin(angle) * (lw/2 + sw/4), Math.cos(angle) * (lw/2 + sw/4), series.xaxis, series.yaxis);
+            }
+
+            ctx.lineWidth = lw;
+            ctx.strokeStyle = series.color;
+            var fillStyle = getFillStyle(series.lines, series.color, 0, plotHeight);
+            if (fillStyle) {
+                ctx.fillStyle = fillStyle;
+                plotLineArea(series.datapoints, series.xaxis, series.yaxis);
+            }
+
+            if (lw > 0)
+                plotLine(series.datapoints, 0, 0, series.xaxis, series.yaxis);
+            ctx.restore();
+        }
+
+        function drawSeriesPoints(series) {
+            function plotPoints(datapoints, radius, fillStyle, offset, shadow, axisx, axisy, symbol) {
+                var points = datapoints.points, ps = datapoints.pointsize;
+
+                for (var i = 0; i < points.length; i += ps) {
+                    var x = points[i], y = points[i + 1];
+                    if (x == null || x < axisx.min || x > axisx.max || y < axisy.min || y > axisy.max)
+                        continue;
+                    
+                    ctx.beginPath();
+                    x = axisx.p2c(x);
+                    y = axisy.p2c(y) + offset;
+                    if (symbol == "circle")
+                        ctx.arc(x, y, radius, 0, shadow ? Math.PI : Math.PI * 2, false);
+                    else
+                        symbol(ctx, x, y, radius, shadow);
+                    ctx.closePath();
+                    
+                    if (fillStyle) {
+                        ctx.fillStyle = fillStyle;
+                        ctx.fill();
+                    }
+                    ctx.stroke();
+                }
+            }
+            
+            ctx.save();
+            ctx.translate(plotOffset.left, plotOffset.top);
+
+            var lw = series.points.lineWidth,
+                sw = series.shadowSize,
+                radius = series.points.radius,
+                symbol = series.points.symbol;
+            if (lw > 0 && sw > 0) {
+                // draw shadow in two steps
+                var w = sw / 2;
+                ctx.lineWidth = w;
+                ctx.strokeStyle = "rgba(0,0,0,0.1)";
+                plotPoints(series.datapoints, radius, null, w + w/2, true,
+                           series.xaxis, series.yaxis, symbol);
+
+                ctx.strokeStyle = "rgba(0,0,0,0.2)";
+                plotPoints(series.datapoints, radius, null, w/2, true,
+                           series.xaxis, series.yaxis, symbol);
+            }
+
+            ctx.lineWidth = lw;
+            ctx.strokeStyle = series.color;
+            plotPoints(series.datapoints, radius,
+                       getFillStyle(series.points, series.color), 0, false,
+                       series.xaxis, series.yaxis, symbol);
+            ctx.restore();
+        }
+
+        function drawBar(x, y, b, barLeft, barRight, offset, fillStyleCallback, axisx, axisy, c, horizontal, lineWidth) {
+            var left, right, bottom, top,
+                drawLeft, drawRight, drawTop, drawBottom,
+                tmp;
+
+            // in horizontal mode, we start the bar from the left
+            // instead of from the bottom so it appears to be
+            // horizontal rather than vertical
+            if (horizontal) {
+                drawBottom = drawRight = drawTop = true;
+                drawLeft = false;
+                left = b;
+                right = x;
+                top = y + barLeft;
+                bottom = y + barRight;
+
+                // account for negative bars
+                if (right < left) {
+                    tmp = right;
+                    right = left;
+                    left = tmp;
+                    drawLeft = true;
+                    drawRight = false;
+                }
+            }
+            else {
+                drawLeft = drawRight = drawTop = true;
+                drawBottom = false;
+                left = x + barLeft;
+                right = x + barRight;
+                bottom = b;
+                top = y;
+
+                // account for negative bars
+                if (top < bottom) {
+                    tmp = top;
+                    top = bottom;
+                    bottom = tmp;
+                    drawBottom = true;
+                    drawTop = false;
+                }
+            }
+           
+            // clip
+            if (right < axisx.min || left > axisx.max ||
+                top < axisy.min || bottom > axisy.max)
+                return;
+            
+            if (left < axisx.min) {
+                left = axisx.min;
+                drawLeft = false;
+            }
+
+            if (right > axisx.max) {
+                right = axisx.max;
+                drawRight = false;
+            }
+
+            if (bottom < axisy.min) {
+                bottom = axisy.min;
+                drawBottom = false;
+            }
+            
+            if (top > axisy.max) {
+                top = axisy.max;
+                drawTop = false;
+            }
+
+            left = axisx.p2c(left);
+            bottom = axisy.p2c(bottom);
+            right = axisx.p2c(right);
+            top = axisy.p2c(top);
+            
+            // fill the bar
+            if (fillStyleCallback) {
+                c.beginPath();
+                c.moveTo(left, bottom);
+                c.lineTo(left, top);
+                c.lineTo(right, top);
+                c.lineTo(right, bottom);
+                c.fillStyle = fillStyleCallback(bottom, top);
+                c.fill();
+            }
+
+            // draw outline
+            if (lineWidth > 0 && (drawLeft || drawRight || drawTop || drawBottom)) {
+                c.beginPath();
+
+                // FIXME: inline moveTo is buggy with excanvas
+                c.moveTo(left, bottom + offset);
+                if (drawLeft)
+                    c.lineTo(left, top + offset);
+                else
+                    c.moveTo(left, top + offset);
+                if (drawTop)
+                    c.lineTo(right, top + offset);
+                else
+                    c.moveTo(right, top + offset);
+                if (drawRight)
+                    c.lineTo(right, bottom + offset);
+                else
+                    c.moveTo(right, bottom + offset);
+                if (drawBottom)
+                    c.lineTo(left, bottom + offset);
+                else
+                    c.moveTo(left, bottom + offset);
+                c.stroke();
+            }
+        }
+        
+        function drawSeriesBars(series) {
+            function plotBars(datapoints, barLeft, barRight, offset, fillStyleCallback, axisx, axisy) {
+                var points = datapoints.points, ps = datapoints.pointsize;
+                
+                for (var i = 0; i < points.length; i += ps) {
+                    if (points[i] == null)
+                        continue;
+                    drawBar(points[i], points[i + 1], points[i + 2], barLeft, barRight, offset, fillStyleCallback, axisx, axisy, ctx, series.bars.horizontal, series.bars.lineWidth);
+                }
+            }
+
+            ctx.save();
+            ctx.translate(plotOffset.left, plotOffset.top);
+
+            // FIXME: figure out a way to add shadows (for instance along the right edge)
+            ctx.lineWidth = series.bars.lineWidth;
+            ctx.strokeStyle = series.color;
+            var barLeft = series.bars.align == "left" ? 0 : -series.bars.barWidth/2;
+            var fillStyleCallback = series.bars.fill ? function (bottom, top) { return getFillStyle(series.bars, series.color, bottom, top); } : null;
+            plotBars(series.datapoints, barLeft, barLeft + series.bars.barWidth, 0, fillStyleCallback, series.xaxis, series.yaxis);
+            ctx.restore();
+        }
+
+        function getFillStyle(filloptions, seriesColor, bottom, top) {
+            var fill = filloptions.fill;
+            if (!fill)
+                return null;
+
+            if (filloptions.fillColor)
+                return getColorOrGradient(filloptions.fillColor, bottom, top, seriesColor);
+            
+            var c = $.color.parse(seriesColor);
+            c.a = typeof fill == "number" ? fill : 0.4;
+            c.normalize();
+            return c.toString();
+        }
+        
+        function insertLegend() {
+            placeholder.find(".legend").remove();
+
+            if (!options.legend.show)
+                return;
+            
+            var fragments = [], rowStarted = false,
+                lf = options.legend.labelFormatter, s, label;
+            for (var i = 0; i < series.length; ++i) {
+                s = series[i];
+                label = s.label;
+                if (!label)
+                    continue;
+                
+                if (i % options.legend.noColumns == 0) {
+                    if (rowStarted)
+                        fragments.push('</tr>');
+                    fragments.push('<tr>');
+                    rowStarted = true;
+                }
+
+                if (lf)
+                    label = lf(label, s);
+                
+                fragments.push(
+                    '<td class="legendColorBox"><div style="border:1px solid ' + options.legend.labelBoxBorderColor + ';padding:1px"><div style="width:4px;height:0;border:5px solid ' + s.color + ';overflow:hidden"></div></div></td>' +
+                    '<td class="legendLabel">' + label + '</td>');
+            }
+            if (rowStarted)
+                fragments.push('</tr>');
+            
+            if (fragments.length == 0)
+                return;
+
+            var table = '<table style="font-size:smaller;color:' + options.grid.color + '">' + fragments.join("") + '</table>';
+            if (options.legend.container != null)
+                $(options.legend.container).html(table);
+            else {
+                var pos = "",
+                    p = options.legend.position,
+                    m = options.legend.margin;
+                if (m[0] == null)
+                    m = [m, m];
+                if (p.charAt(0) == "n")
+                    pos += 'top:' + (m[1] + plotOffset.top) + 'px;';
+                else if (p.charAt(0) == "s")
+                    pos += 'bottom:' + (m[1] + plotOffset.bottom) + 'px;';
+                if (p.charAt(1) == "e")
+                    pos += 'right:' + (m[0] + plotOffset.right) + 'px;';
+                else if (p.charAt(1) == "w")
+                    pos += 'left:' + (m[0] + plotOffset.left) + 'px;';
+                var legend = $('<div class="legend">' + table.replace('style="', 'style="position:absolute;' + pos +';') + '</div>').appendTo(placeholder);
+                if (options.legend.backgroundOpacity != 0.0) {
+                    // put in the transparent background
+                    // separately to avoid blended labels and
+                    // label boxes
+                    var c = options.legend.backgroundColor;
+                    if (c == null) {
+                        c = options.grid.backgroundColor;
+                        if (c && typeof c == "string")
+                            c = $.color.parse(c);
+                        else
+                            c = $.color.extract(legend, 'background-color');
+                        c.a = 1;
+                        c = c.toString();
+                    }
+                    var div = legend.children();
+                    $('<div style="position:absolute;width:' + div.width() + 'px;height:' + div.height() + 'px;' + pos +'background-color:' + c + ';"> </div>').prependTo(legend).css('opacity', options.legend.backgroundOpacity);
+                }
+            }
+        }
+
+
+        // interactive features
+        
+        var highlights = [],
+            redrawTimeout = null;
+        
+        // returns the data item the mouse is over, or null if none is found
+        function findNearbyItem(mouseX, mouseY, seriesFilter) {
+            var maxDistance = options.grid.mouseActiveRadius,
+                smallestDistance = maxDistance * maxDistance + 1,
+                item = null, foundPoint = false, i, j;
+
+            for (i = series.length - 1; i >= 0; --i) {
+                if (!seriesFilter(series[i]))
+                    continue;
+                
+                var s = series[i],
+                    axisx = s.xaxis,
+                    axisy = s.yaxis,
+                    points = s.datapoints.points,
+                    ps = s.datapoints.pointsize,
+                    mx = axisx.c2p(mouseX), // precompute some stuff to make the loop faster
+                    my = axisy.c2p(mouseY),
+                    maxx = maxDistance / axisx.scale,
+                    maxy = maxDistance / axisy.scale;
+
+                // with inverse transforms, we can't use the maxx/maxy
+                // optimization, sadly
+                if (axisx.options.inverseTransform)
+                    maxx = Number.MAX_VALUE;
+                if (axisy.options.inverseTransform)
+                    maxy = Number.MAX_VALUE;
+                
+                if (s.lines.show || s.points.show) {
+                    for (j = 0; j < points.length; j += ps) {
+                        var x = points[j], y = points[j + 1];
+                        if (x == null)
+                            continue;
+                        
+                        // For points and lines, the cursor must be within a
+                        // certain distance to the data point
+                        if (x - mx > maxx || x - mx < -maxx ||
+                            y - my > maxy || y - my < -maxy)
+                            continue;
+
+                        // We have to calculate distances in pixels, not in
+                        // data units, because the scales of the axes may be different
+                        var dx = Math.abs(axisx.p2c(x) - mouseX),
+                            dy = Math.abs(axisy.p2c(y) - mouseY),
+                            dist = dx * dx + dy * dy; // we save the sqrt
+
+                        // use <= to ensure last point takes precedence
+                        // (last generally means on top of)
+                        if (dist < smallestDistance) {
+                            smallestDistance = dist;
+                            item = [i, j / ps];
+                        }
+                    }
+                }
+                    
+                if (s.bars.show && !item) { // no other point can be nearby
+                    var barLeft = s.bars.align == "left" ? 0 : -s.bars.barWidth/2,
+                        barRight = barLeft + s.bars.barWidth;
+                    
+                    for (j = 0; j < points.length; j += ps) {
+                        var x = points[j], y = points[j + 1], b = points[j + 2];
+                        if (x == null)
+                            continue;
+  
+                        // for a bar graph, the cursor must be inside the bar
+                        if (series[i].bars.horizontal ? 
+                            (mx <= Math.max(b, x) && mx >= Math.min(b, x) && 
+                             my >= y + barLeft && my <= y + barRight) :
+                            (mx >= x + barLeft && mx <= x + barRight &&
+                             my >= Math.min(b, y) && my <= Math.max(b, y)))
+                                item = [i, j / ps];
+                    }
+                }
+            }
+
+            if (item) {
+                i = item[0];
+                j = item[1];
+                ps = series[i].datapoints.pointsize;
+                
+                return { datapoint: series[i].datapoints.points.slice(j * ps, (j + 1) * ps),
+                         dataIndex: j,
+                         series: series[i],
+                         seriesIndex: i };
+            }
+            
+            return null;
+        }
+
+        function onMouseMove(e) {
+            if (options.grid.hoverable)
+                triggerClickHoverEvent("plothover", e,
+                                       function (s) { return s["hoverable"] != false; });
+        }
+
+        function onMouseLeave(e) {
+            if (options.grid.hoverable)
+                triggerClickHoverEvent("plothover", e,
+                                       function (s) { return false; });
+        }
+
+        function onClick(e) {
+            triggerClickHoverEvent("plotclick", e,
+                                   function (s) { return s["clickable"] != false; });
+        }
+
+        // trigger click or hover event (they send the same parameters
+        // so we share their code)
+        function triggerClickHoverEvent(eventname, event, seriesFilter) {
+            var offset = eventHolder.offset(),
+                canvasX = event.pageX - offset.left - plotOffset.left,
+                canvasY = event.pageY - offset.top - plotOffset.top,
+            pos = canvasToAxisCoords({ left: canvasX, top: canvasY });
+
+            pos.pageX = event.pageX;
+            pos.pageY = event.pageY;
+
+            var item = findNearbyItem(canvasX, canvasY, seriesFilter);
+
+            if (item) {
+                // fill in mouse pos for any listeners out there
+                item.pageX = parseInt(item.series.xaxis.p2c(item.datapoint[0]) + offset.left + plotOffset.left);
+                item.pageY = parseInt(item.series.yaxis.p2c(item.datapoint[1]) + offset.top + plotOffset.top);
+            }
+
+            if (options.grid.autoHighlight) {
+                // clear auto-highlights
+                for (var i = 0; i < highlights.length; ++i) {
+                    var h = highlights[i];
+                    if (h.auto == eventname &&
+                        !(item && h.series == item.series &&
+                          h.point[0] == item.datapoint[0] &&
+                          h.point[1] == item.datapoint[1]))
+                        unhighlight(h.series, h.point);
+                }
+                
+                if (item)
+                    highlight(item.series, item.datapoint, eventname);
+            }
+            
+            placeholder.trigger(eventname, [ pos, item ]);
+        }
+
+        function triggerRedrawOverlay() {
+            if (!redrawTimeout)
+                redrawTimeout = setTimeout(drawOverlay, 30);
+        }
+
+        function drawOverlay() {
+            redrawTimeout = null;
+
+            // draw highlights
+            octx.save();
+            octx.clearRect(0, 0, canvasWidth, canvasHeight);
+            octx.translate(plotOffset.left, plotOffset.top);
+            
+            var i, hi;
+            for (i = 0; i < highlights.length; ++i) {
+                hi = highlights[i];
+
+                if (hi.series.bars.show)
+                    drawBarHighlight(hi.series, hi.point);
+                else
+                    drawPointHighlight(hi.series, hi.point);
+            }
+            octx.restore();
+            
+            executeHooks(hooks.drawOverlay, [octx]);
+        }
+        
+        function highlight(s, point, auto) {
+            if (typeof s == "number")
+                s = series[s];
+
+            if (typeof point == "number") {
+                var ps = s.datapoints.pointsize;
+                point = s.datapoints.points.slice(ps * point, ps * (point + 1));
+            }
+
+            var i = indexOfHighlight(s, point);
+            if (i == -1) {
+                highlights.push({ series: s, point: point, auto: auto });
+
+                triggerRedrawOverlay();
+            }
+            else if (!auto)
+                highlights[i].auto = false;
+        }
+            
+        function unhighlight(s, point) {
+            if (s == null && point == null) {
+                highlights = [];
+                triggerRedrawOverlay();
+            }
+            
+            if (typeof s == "number")
+                s = series[s];
+
+            if (typeof point == "number")
+                point = s.data[point];
+
+            var i = indexOfHighlight(s, point);
+            if (i != -1) {
+                highlights.splice(i, 1);
+
+                triggerRedrawOverlay();
+            }
+        }
+        
+        function indexOfHighlight(s, p) {
+            for (var i = 0; i < highlights.length; ++i) {
+                var h = highlights[i];
+                if (h.series == s && h.point[0] == p[0]
+                    && h.point[1] == p[1])
+                    return i;
+            }
+            return -1;
+        }
+        
+        function drawPointHighlight(series, point) {
+            var x = point[0], y = point[1],
+                axisx = series.xaxis, axisy = series.yaxis;
+            
+            if (x < axisx.min || x > axisx.max || y < axisy.min || y > axisy.max)
+                return;
+            
+            var pointRadius = series.points.radius + series.points.lineWidth / 2;
+            octx.lineWidth = pointRadius;
+            octx.strokeStyle = $.color.parse(series.color).scale('a', 0.5).toString();
+            var radius = 1.5 * pointRadius,
+                x = axisx.p2c(x),
+                y = axisy.p2c(y);
+            
+            octx.beginPath();
+            if (series.points.symbol == "circle")
+                octx.arc(x, y, radius, 0, 2 * Math.PI, false);
+            else
+                series.points.symbol(octx, x, y, radius, false);
+            octx.closePath();
+            octx.stroke();
+        }
+
+        function drawBarHighlight(series, point) {
+            octx.lineWidth = series.bars.lineWidth;
+            octx.strokeStyle = $.color.parse(series.color).scale('a', 0.5).toString();
+            var fillStyle = $.color.parse(series.color).scale('a', 0.5).toString();
+            var barLeft = series.bars.align == "left" ? 0 : -series.bars.barWidth/2;
+            drawBar(point[0], point[1], point[2] || 0, barLeft, barLeft + series.bars.barWidth,
+                    0, function () { return fillStyle; }, series.xaxis, series.yaxis, octx, series.bars.horizontal, series.bars.lineWidth);
+        }
+
+        function getColorOrGradient(spec, bottom, top, defaultColor) {
+            if (typeof spec == "string")
+                return spec;
+            else {
+                // assume this is a gradient spec; IE currently only
+                // supports a simple vertical gradient properly, so that's
+                // what we support too
+                var gradient = ctx.createLinearGradient(0, top, 0, bottom);
+                
+                for (var i = 0, l = spec.colors.length; i < l; ++i) {
+                    var c = spec.colors[i];
+                    if (typeof c != "string") {
+                        var co = $.color.parse(defaultColor);
+                        if (c.brightness != null)
+                            co = co.scale('rgb', c.brightness)
+                        if (c.opacity != null)
+                            co.a *= c.opacity;
+                        c = co.toString();
+                    }
+                    gradient.addColorStop(i / (l - 1), c);
+                }
+                
+                return gradient;
+            }
+        }
+    }
+
+    $.plot = function(placeholder, data, options) {
+        //var t0 = new Date();
+        var plot = new Plot($(placeholder), data, options, $.plot.plugins);
+        //(window.console ? console.log : alert)("time used (msecs): " + ((new Date()).getTime() - t0.getTime()));
+        return plot;
+    };
+
+    $.plot.version = "0.7";
+    
+    $.plot.plugins = [];
+
+    // returns a string with the date d formatted according to fmt
+    $.plot.formatDate = function(d, fmt, monthNames) {
+        var leftPad = function(n) {
+            n = "" + n;
+            return n.length == 1 ? "0" + n : n;
+        };
+        
+        var r = [];
+        var escape = false, padNext = false;
+        var hours = d.getUTCHours();
+        var isAM = hours < 12;
+        if (monthNames == null)
+            monthNames = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"];
+
+        if (fmt.search(/%p|%P/) != -1) {
+            if (hours > 12) {
+                hours = hours - 12;
+            } else if (hours == 0) {
+                hours = 12;
+            }
+        }
+        for (var i = 0; i < fmt.length; ++i) {
+            var c = fmt.charAt(i);
+            
+            if (escape) {
+                switch (c) {
+                case 'h': c = "" + hours; break;
+                case 'H': c = leftPad(hours); break;
+                case 'M': c = leftPad(d.getUTCMinutes()); break;
+                case 'S': c = leftPad(d.getUTCSeconds()); break;
+                case 'd': c = "" + d.getUTCDate(); break;
+                case 'm': c = "" + (d.getUTCMonth() + 1); break;
+                case 'y': c = "" + d.getUTCFullYear(); break;
+                case 'b': c = "" + monthNames[d.getUTCMonth()]; break;
+                case 'p': c = (isAM) ? ("" + "am") : ("" + "pm"); break;
+                case 'P': c = (isAM) ? ("" + "AM") : ("" + "PM"); break;
+                case '0': c = ""; padNext = true; break;
+                }
+                if (c && padNext) {
+                    c = leftPad(c);
+                    padNext = false;
+                }
+                r.push(c);
+                if (!padNext)
+                    escape = false;
+            }
+            else {
+                if (c == "%")
+                    escape = true;
+                else
+                    r.push(c);
+            }
+        }
+        return r.join("");
+    };
+    
+    // round to nearby lower multiple of base
+    function floorInBase(n, base) {
+        return base * Math.floor(n / base);
+    }
+    
+})(jQuery);
diff --git a/collects/meta/drdr/static/jquery.flot.selection.js b/collects/meta/drdr/static/jquery.flot.selection.js
new file mode 100644
index 0000000000..7f7b32694b
--- /dev/null
+++ b/collects/meta/drdr/static/jquery.flot.selection.js
@@ -0,0 +1,344 @@
+/*
+Flot plugin for selecting regions.
+
+The plugin defines the following options:
+
+  selection: {
+    mode: null or "x" or "y" or "xy",
+    color: color
+  }
+
+Selection support is enabled by setting the mode to one of "x", "y" or
+"xy". In "x" mode, the user will only be able to specify the x range,
+similarly for "y" mode. For "xy", the selection becomes a rectangle
+where both ranges can be specified. "color" is color of the selection
+(if you need to change the color later on, you can get to it with
+plot.getOptions().selection.color).
+
+When selection support is enabled, a "plotselected" event will be
+emitted on the DOM element you passed into the plot function. The
+event handler gets a parameter with the ranges selected on the axes,
+like this:
+
+  placeholder.bind("plotselected", function(event, ranges) {
+    alert("You selected " + ranges.xaxis.from + " to " + ranges.xaxis.to)
+    // similar for yaxis - with multiple axes, the extra ones are in
+    // x2axis, x3axis, ...
+  });
+
+The "plotselected" event is only fired when the user has finished
+making the selection. A "plotselecting" event is fired during the
+process with the same parameters as the "plotselected" event, in case
+you want to know what's happening while it's happening,
+
+A "plotunselected" event with no arguments is emitted when the user
+clicks the mouse to remove the selection.
+
+The plugin allso adds the following methods to the plot object:
+
+- setSelection(ranges, preventEvent)
+
+  Set the selection rectangle. The passed in ranges is on the same
+  form as returned in the "plotselected" event. If the selection mode
+  is "x", you should put in either an xaxis range, if the mode is "y"
+  you need to put in an yaxis range and both xaxis and yaxis if the
+  selection mode is "xy", like this:
+
+    setSelection({ xaxis: { from: 0, to: 10 }, yaxis: { from: 40, to: 60 } });
+
+  setSelection will trigger the "plotselected" event when called. If
+  you don't want that to happen, e.g. if you're inside a
+  "plotselected" handler, pass true as the second parameter. If you
+  are using multiple axes, you can specify the ranges on any of those,
+  e.g. as x2axis/x3axis/... instead of xaxis, the plugin picks the
+  first one it sees.
+  
+- clearSelection(preventEvent)
+
+  Clear the selection rectangle. Pass in true to avoid getting a
+  "plotunselected" event.
+
+- getSelection()
+
+  Returns the current selection in the same format as the
+  "plotselected" event. If there's currently no selection, the
+  function returns null.
+
+*/
+
+(function ($) {
+    function init(plot) {
+        var selection = {
+                first: { x: -1, y: -1}, second: { x: -1, y: -1},
+                show: false,
+                active: false
+            };
+
+        // FIXME: The drag handling implemented here should be
+        // abstracted out, there's some similar code from a library in
+        // the navigation plugin, this should be massaged a bit to fit
+        // the Flot cases here better and reused. Doing this would
+        // make this plugin much slimmer.
+        var savedhandlers = {};
+
+        var mouseUpHandler = null;
+        
+        function onMouseMove(e) {
+            if (selection.active) {
+                updateSelection(e);
+                
+                plot.getPlaceholder().trigger("plotselecting", [ getSelection() ]);
+            }
+        }
+
+        function onMouseDown(e) {
+            if (e.which != 1)  // only accept left-click
+                return;
+            
+            // cancel out any text selections
+            document.body.focus();
+
+            // prevent text selection and drag in old-school browsers
+            if (document.onselectstart !== undefined && savedhandlers.onselectstart == null) {
+                savedhandlers.onselectstart = document.onselectstart;
+                document.onselectstart = function () { return false; };
+            }
+            if (document.ondrag !== undefined && savedhandlers.ondrag == null) {
+                savedhandlers.ondrag = document.ondrag;
+                document.ondrag = function () { return false; };
+            }
+
+            setSelectionPos(selection.first, e);
+
+            selection.active = true;
+
+            // this is a bit silly, but we have to use a closure to be
+            // able to whack the same handler again
+            mouseUpHandler = function (e) { onMouseUp(e); };
+            
+            $(document).one("mouseup", mouseUpHandler);
+        }
+
+        function onMouseUp(e) {
+            mouseUpHandler = null;
+            
+            // revert drag stuff for old-school browsers
+            if (document.onselectstart !== undefined)
+                document.onselectstart = savedhandlers.onselectstart;
+            if (document.ondrag !== undefined)
+                document.ondrag = savedhandlers.ondrag;
+
+            // no more dragging
+            selection.active = false;
+            updateSelection(e);
+
+            if (selectionIsSane())
+                triggerSelectedEvent();
+            else {
+                // this counts as a clear
+                plot.getPlaceholder().trigger("plotunselected", [ ]);
+                plot.getPlaceholder().trigger("plotselecting", [ null ]);
+            }
+
+            return false;
+        }
+
+        function getSelection() {
+            if (!selectionIsSane())
+                return null;
+
+            var r = {}, c1 = selection.first, c2 = selection.second;
+            $.each(plot.getAxes(), function (name, axis) {
+                if (axis.used) {
+                    var p1 = axis.c2p(c1[axis.direction]), p2 = axis.c2p(c2[axis.direction]); 
+                    r[name] = { from: Math.min(p1, p2), to: Math.max(p1, p2) };
+                }
+            });
+            return r;
+        }
+
+        function triggerSelectedEvent() {
+            var r = getSelection();
+
+            plot.getPlaceholder().trigger("plotselected", [ r ]);
+
+            // backwards-compat stuff, to be removed in future
+            if (r.xaxis && r.yaxis)
+                plot.getPlaceholder().trigger("selected", [ { x1: r.xaxis.from, y1: r.yaxis.from, x2: r.xaxis.to, y2: r.yaxis.to } ]);
+        }
+
+        function clamp(min, value, max) {
+            return value < min ? min: (value > max ? max: value);
+        }
+
+        function setSelectionPos(pos, e) {
+            var o = plot.getOptions();
+            var offset = plot.getPlaceholder().offset();
+            var plotOffset = plot.getPlotOffset();
+            pos.x = clamp(0, e.pageX - offset.left - plotOffset.left, plot.width());
+            pos.y = clamp(0, e.pageY - offset.top - plotOffset.top, plot.height());
+
+            if (o.selection.mode == "y")
+                pos.x = pos == selection.first ? 0 : plot.width();
+
+            if (o.selection.mode == "x")
+                pos.y = pos == selection.first ? 0 : plot.height();
+        }
+
+        function updateSelection(pos) {
+            if (pos.pageX == null)
+                return;
+
+            setSelectionPos(selection.second, pos);
+            if (selectionIsSane()) {
+                selection.show = true;
+                plot.triggerRedrawOverlay();
+            }
+            else
+                clearSelection(true);
+        }
+
+        function clearSelection(preventEvent) {
+            if (selection.show) {
+                selection.show = false;
+                plot.triggerRedrawOverlay();
+                if (!preventEvent)
+                    plot.getPlaceholder().trigger("plotunselected", [ ]);
+            }
+        }
+
+        // function taken from markings support in Flot
+        function extractRange(ranges, coord) {
+            var axis, from, to, key, axes = plot.getAxes();
+
+            for (var k in axes) {
+                axis = axes[k];
+                if (axis.direction == coord) {
+                    key = coord + axis.n + "axis";
+                    if (!ranges[key] && axis.n == 1)
+                        key = coord + "axis"; // support x1axis as xaxis
+                    if (ranges[key]) {
+                        from = ranges[key].from;
+                        to = ranges[key].to;
+                        break;
+                    }
+                }
+            }
+
+            // backwards-compat stuff - to be removed in future
+            if (!ranges[key]) {
+                axis = coord == "x" ? plot.getXAxes()[0] : plot.getYAxes()[0];
+                from = ranges[coord + "1"];
+                to = ranges[coord + "2"];
+            }
+
+            // auto-reverse as an added bonus
+            if (from != null && to != null && from > to) {
+                var tmp = from;
+                from = to;
+                to = tmp;
+            }
+            
+            return { from: from, to: to, axis: axis };
+        }
+        
+        function setSelection(ranges, preventEvent) {
+            var axis, range, o = plot.getOptions();
+
+            if (o.selection.mode == "y") {
+                selection.first.x = 0;
+                selection.second.x = plot.width();
+            }
+            else {
+                range = extractRange(ranges, "x");
+
+                selection.first.x = range.axis.p2c(range.from);
+                selection.second.x = range.axis.p2c(range.to);
+            }
+
+            if (o.selection.mode == "x") {
+                selection.first.y = 0;
+                selection.second.y = plot.height();
+            }
+            else {
+                range = extractRange(ranges, "y");
+
+                selection.first.y = range.axis.p2c(range.from);
+                selection.second.y = range.axis.p2c(range.to);
+            }
+
+            selection.show = true;
+            plot.triggerRedrawOverlay();
+            if (!preventEvent && selectionIsSane())
+                triggerSelectedEvent();
+        }
+
+        function selectionIsSane() {
+            var minSize = 5;
+            return Math.abs(selection.second.x - selection.first.x) >= minSize &&
+                Math.abs(selection.second.y - selection.first.y) >= minSize;
+        }
+
+        plot.clearSelection = clearSelection;
+        plot.setSelection = setSelection;
+        plot.getSelection = getSelection;
+
+        plot.hooks.bindEvents.push(function(plot, eventHolder) {
+            var o = plot.getOptions();
+            if (o.selection.mode != null) {
+                eventHolder.mousemove(onMouseMove);
+                eventHolder.mousedown(onMouseDown);
+            }
+        });
+
+
+        plot.hooks.drawOverlay.push(function (plot, ctx) {
+            // draw selection
+            if (selection.show && selectionIsSane()) {
+                var plotOffset = plot.getPlotOffset();
+                var o = plot.getOptions();
+
+                ctx.save();
+                ctx.translate(plotOffset.left, plotOffset.top);
+
+                var c = $.color.parse(o.selection.color);
+
+                ctx.strokeStyle = c.scale('a', 0.8).toString();
+                ctx.lineWidth = 1;
+                ctx.lineJoin = "round";
+                ctx.fillStyle = c.scale('a', 0.4).toString();
+
+                var x = Math.min(selection.first.x, selection.second.x),
+                    y = Math.min(selection.first.y, selection.second.y),
+                    w = Math.abs(selection.second.x - selection.first.x),
+                    h = Math.abs(selection.second.y - selection.first.y);
+
+                ctx.fillRect(x, y, w, h);
+                ctx.strokeRect(x, y, w, h);
+
+                ctx.restore();
+            }
+        });
+        
+        plot.hooks.shutdown.push(function (plot, eventHolder) {
+            eventHolder.unbind("mousemove", onMouseMove);
+            eventHolder.unbind("mousedown", onMouseDown);
+            
+            if (mouseUpHandler)
+                $(document).unbind("mouseup", mouseUpHandler);
+        });
+
+    }
+
+    $.plot.plugins.push({
+        init: init,
+        options: {
+            selection: {
+                mode: null, // one of null, "x", "y" or "xy"
+                color: "#e8cfac"
+            }
+        },
+        name: 'selection',
+        version: '1.1'
+    });
+})(jQuery);
diff --git a/collects/meta/drdr/time.rkt b/collects/meta/drdr/time.rkt
index 2a404f2f71..41f993b4e6 100644
--- a/collects/meta/drdr/time.rkt
+++ b/collects/meta/drdr/time.rkt
@@ -1,7 +1,6 @@
 #lang racket
 (require (planet jaymccarthy/job-queue)
          racket/system
-         (prefix-in graph-one: "graph.rkt")
          "config.rkt"
          "notify.rkt"
          "dirstruct.rkt"
@@ -12,14 +11,11 @@
 
 (define start-revision #f)
 (define history? #f)
-(define just-graphs? #f)
 
 (command-line #:program "time"
               #:once-each
               ["-H" "Run on all revisions"
                     (set! history? #t)]
-              ["-G" "Just graphs"
-                    (set! just-graphs? #t)]
               ["-r" rev
                     "Start with a particular revision"
                     (set! start-revision (string->number rev))])
@@ -34,23 +30,20 @@
   (submit-job!
    test-workers
    (lambda ()
-     (unless just-graphs?
-       (notify! "Dropping timing for ~a" filename)
-       (apply 
-        system*/exit-code
-        (path->string
-         (build-path (plt-directory) "plt" "bin" "racket"))
-        "-t" 
-        (path->string (build-path (drdr-directory) "time-file.rkt"))
-        "--"
-        (append
-         (if history?
-             (list "-H")
-             (list "-r" (number->string start-revision)))
-         (list
-          (path->string filename)))))
-     (notify! "Generating graph for ~a" filename)
-     (graph-one:main filename)
+     (notify! "Dropping timing for ~a" filename)
+     (apply 
+      system*/exit-code
+      (path->string
+       (build-path (plt-directory) "plt" "bin" "racket"))
+      "-t" 
+      (path->string (build-path (drdr-directory) "time-file.rkt"))
+      "--"
+      (append
+       (if history?
+           (list "-H")
+           (list "-r" (number->string start-revision)))
+       (list
+        (path->string filename))))
      (notify! "Done with ~a" filename)
      (semaphore-post count-sema))))
 
diff --git a/collects/meta/props b/collects/meta/props
index 7d96ff795d..992b4f6f08 100755
--- a/collects/meta/props
+++ b/collects/meta/props
@@ -1275,7 +1275,7 @@ path/s is either such a string or a list of them.
 "collects/scribble/text" responsible (eli)
 "collects/scribble/text.rkt" responsible (eli)
 "collects/scribble/tools" responsible (robby)
-"collects/scribble/tools/drracket-buttons.rkt" drdr:command-line (gracket-text *)
+"collects/scribble/tools/drracket-buttons.rkt" drdr:command-line #f
 "collects/scribble/tools/private/mk-drs-bitmaps.rkt" drdr:command-line (gracket-text * "skip")
 "collects/scribblings" responsible (mflatt eli robby matthias)
 "collects/scribblings/framework/standard-menus.scrbl" drdr:command-line #f
@@ -1432,8 +1432,8 @@ path/s is either such a string or a list of them.
 "collects/tests/drracket/example-tool.rkt" drdr:command-line (gracket "-t" *)
 "collects/tests/drracket/get-defs-test.rkt" drdr:command-line (gracket *)
 "collects/tests/drracket/hangman.rkt" responsible (robby matthias) drdr:command-line (gracket *)
-"collects/tests/drracket/io.rkt" drdr:command-line (gracket *)
-"collects/tests/drracket/language-test.rkt" responsible (robby matthias) drdr:command-line (gracket *) drdr:timeout 600
+"collects/tests/drracket/io.rkt" drdr:command-line (gracket *) drdr:timeout 500
+"collects/tests/drracket/language-test.rkt" responsible (robby matthias) drdr:command-line (gracket *) drdr:timeout 1500
 "collects/tests/drracket/leaky-frame.rkt" drdr:command-line (gracket *)
 "collects/tests/drracket/memory-log.rkt" drdr:command-line (gracket *)
 "collects/tests/drracket/module-lang-test-utils.rkt" drdr:command-line (gracket-text "-t" *)
@@ -1504,7 +1504,7 @@ path/s is either such a string or a list of them.
 "collects/tests/gracket/wxme.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/tests/honu" responsible (rafkind)
 "collects/tests/htdp-lang" responsible (robby mflatt matthias)
-"collects/tests/htdp-lang/advanced.rktl" drdr:command-line (racket "-f" *) drdr:timeout 180
+"collects/tests/htdp-lang/advanced.rktl" drdr:command-line (racket "-f" *) drdr:timeout 360
 "collects/tests/htdp-lang/basic.rktl" drdr:command-line #f
 "collects/tests/htdp-lang/beg-adv.rktl" drdr:command-line #f
 "collects/tests/htdp-lang/beg-bega.rktl" drdr:command-line #f
@@ -1516,8 +1516,8 @@ path/s is either such a string or a list of them.
 "collects/tests/htdp-lang/htdp-image.rktl" responsible (robby) drdr:command-line (gracket "-f" *)
 "collects/tests/htdp-lang/htdp-test.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/htdp-lang/htdp.rktl" drdr:command-line #f
-"collects/tests/htdp-lang/intermediate-lambda.rktl" drdr:command-line (racket "-f" *)
-"collects/tests/htdp-lang/intermediate.rktl" drdr:command-line (racket "-f" *)
+"collects/tests/htdp-lang/intermediate-lambda.rktl" drdr:command-line (racket "-f" *) drdr:timeout 360
+"collects/tests/htdp-lang/intermediate.rktl" drdr:command-line (racket "-f" *) drdr:timeout 360
 "collects/tests/htdp-lang/intm-adv.rktl" drdr:command-line #f
 "collects/tests/htdp-lang/intm-intml.rktl" drdr:command-line #f
 "collects/tests/htdp-lang/intmlam-adv.rktl" drdr:command-line #f
@@ -1566,7 +1566,7 @@ path/s is either such a string or a list of them.
 "collects/tests/planet/examples/dummy-module.rkt" drdr:command-line #f
 "collects/tests/planet/examples/scribblings-package" drdr:command-line #f
 "collects/tests/planet/lang.rkt" drdr:command-line (raco "make" *)
-"collects/tests/planet/run-all.rkt" drdr:command-line (racket *) drdr:timeout 1000
+"collects/tests/planet/run-all.rkt" drdr:command-line (racket *) drdr:timeout 240
 "collects/tests/planet/test-docs-complete.rkt" drdr:command-line (raco "make" *)
 "collects/tests/planet/thread-safe-resolver.rkt" drdr:command-line (raco "make" *) drdr:timeout 1000
 "collects/tests/planet/version.rkt" drdr:command-line (raco "make" *)
@@ -1608,7 +1608,7 @@ path/s is either such a string or a list of them.
 "collects/tests/racket/benchmarks/mz/expand-class.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/racket/benchmarks/mz/parsing.rktl" drdr:command-line (gracket "-f" *)
 "collects/tests/racket/benchmarks/mz/redsem.rktl" drdr:command-line (racket "-f" * "--" "--skip-struct-test")
-"collects/tests/racket/benchmarks/mz/ssax.rktl" drdr:command-line (racket "-f" *)
+"collects/tests/racket/benchmarks/mz/ssax.rktl" drdr:command-line (racket "-W" "info" "-f" *) drdr:timeout 900
 "collects/tests/racket/benchmarks/places" drdr:command-line #f
 "collects/tests/racket/benchmarks/rx/auto.rkt" drdr:command-line (racket "-t" * "--" "racket" "simple") drdr:timeout 600
 "collects/tests/racket/benchmarks/shootout/ackermann.rkt" drdr:command-line (racket "-t" * "--" "10")
@@ -1840,7 +1840,10 @@ path/s is either such a string or a list of them.
 "collects/tests/racket/pconvert.rktl" drdr:command-line #f
 "collects/tests/racket/place-chan-rand-help.rkt" responsible (tewk)
 "collects/tests/racket/place-chan-rand.rkt" responsible (tewk) drdr:random #t
+"collects/tests/racket/place-channel-fd.rkt" responsible (tewk) drdr:command-line (racket "-tm" *)
+"collects/tests/racket/place-channel-fd2.rkt" responsible (tewk) drdr:command-line (racket "-tm" *)
 "collects/tests/racket/place-channel-ffi.rkt" responsible (tewk) drdr:command-line (racket "-tm" *)
+"collects/tests/racket/place-channel-socket.rkt" responsible (tewk) drdr:command-line (racket "-tm" *)
 "collects/tests/racket/place-channel.rkt" responsible (tewk) drdr:command-line (racket "-tm" *) drdr:timeout 300
 "collects/tests/racket/place.rktl" responsible (tewk) drdr:command-line (racket "-f" *)
 "collects/tests/racket/port.rktl" drdr:command-line #f
@@ -1853,6 +1856,7 @@ path/s is either such a string or a list of them.
 "collects/tests/racket/read.rktl" drdr:command-line #f
 "collects/tests/racket/readtable.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/racket/restart.rktl" drdr:command-line (racket "-f" *)
+"collects/tests/racket/runaway-place.rkt" drdr:command-line (racket "-tm" *)
 "collects/tests/racket/runflats.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/racket/rx.rktl" drdr:command-line #f
 "collects/tests/racket/sandbox.rktl" drdr:command-line (racket "-f" *)
@@ -1959,15 +1963,15 @@ path/s is either such a string or a list of them.
 "collects/tests/syntax-color/paren-tree.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/syntax-color/token-tree.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/test-engine" responsible (kathyg)
-"collects/tests/typed-scheme" responsible (samth stamourv)
-"collects/tests/typed-scheme/fail" drdr:command-line #f
-"collects/tests/typed-scheme/fail/with-type3.rkt" responsible (sstrickl)
-"collects/tests/typed-scheme/nightly-run.rkt" drdr:command-line #f
-"collects/tests/typed-scheme/optimizer" responsible (stamourv)
-"collects/tests/typed-scheme/optimizer/run.rkt" drdr:timeout 1200
-"collects/tests/typed-scheme/optimizer/transform.rkt" drdr:command-line #f
-"collects/tests/typed-scheme/run.rkt" drdr:command-line (racket "-t" * "--" "--nightly") drdr:timeout 1800
-"collects/tests/typed-scheme/xfail" drdr:command-line #f
+"collects/tests/typed-racket" responsible (samth stamourv)
+"collects/tests/typed-racket/fail" drdr:command-line #f
+"collects/tests/typed-racket/fail/with-type3.rkt" responsible (sstrickl)
+"collects/tests/typed-racket/nightly-run.rkt" drdr:command-line #f
+"collects/tests/typed-racket/optimizer" responsible (stamourv)
+"collects/tests/typed-racket/optimizer/run.rkt" drdr:timeout 1200
+"collects/tests/typed-racket/optimizer/transform.rkt" drdr:command-line #f
+"collects/tests/typed-racket/run.rkt" drdr:command-line (racket "-t" * "--" "--nightly") drdr:timeout 1800
+"collects/tests/typed-racket/xfail" drdr:command-line #f
 "collects/tests/units" responsible (sstrickl)
 "collects/tests/units/multi-mod-sigs.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/units/test-cert.rktl" drdr:command-line (racket "-f" *)
@@ -2021,9 +2025,10 @@ path/s is either such a string or a list of them.
 "collects/typed/mred/mred.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/typed/rackunit" responsible (jay)
 "collects/typed/rackunit/gui.rkt" drdr:command-line (gracket "-t" *)
+"collects/typed-racket" responsible (samth stamourv)
+"collects/typed-racket/base-env/base-special-env.rkt" drdr:command-line (raco "make" *)
+"collects/typed-racket/optimizer" responsible (stamourv)
 "collects/typed-scheme" responsible (samth stamourv)
-"collects/typed-scheme/base-env/base-special-env.rkt" drdr:command-line (raco "make" *)
-"collects/typed-scheme/optimizer" responsible (stamourv)
 "collects/unstable" responsible (jay samth cce ryanc)
 "collects/unstable/automata" responsible (jay)
 "collects/unstable/byte-counting-port.rkt" responsible (jay)
diff --git a/collects/meta/web/www/people.rkt b/collects/meta/web/www/people.rkt
index a10ce4bda1..3259719f34 100644
--- a/collects/meta/web/www/people.rkt
+++ b/collects/meta/web/www/people.rkt
@@ -113,6 +113,6 @@
        In particular, please check out the Racket-related work being done at
        @|-schematics|.}
     @h4{And ...}
-    @p{Finally, Racket is supported by an band of volunteers who contribute not
+    @p{Finally, Racket is supported by a band of volunteers who contribute not
        only code and documentation but also infectious enthusiasm—too many to
        name but whose help and encouragement make this fun and worthwhile.}})
diff --git a/collects/mred/private/filedialog.rkt b/collects/mred/private/filedialog.rkt
index 8e74c0d481..cd5a92bbe6 100644
--- a/collects/mred/private/filedialog.rkt
+++ b/collects/mred/private/filedialog.rkt
@@ -1,97 +1,94 @@
-(module filedialog mzscheme
-  (require mzlib/class
-           mzlib/etc
-           mzlib/list
-           (prefix wx: "kernel.rkt")
-           (prefix wx: racket/snip)
-           (rename "wxme/cycle.rkt" wx:set-editor-get-file! set-editor-get-file!)
-           (rename "wxme/cycle.rkt" wx:set-editor-put-file! set-editor-put-file!)
-           "lock.rkt"
-           "wx.rkt"
-           "cycle.rkt"
-           "check.rkt"
-           "mrtop.rkt"
-           "path-dialog.rkt")
+#lang racket/base
+(require racket/class
+         (prefix-in wx: "kernel.rkt")
+         (rename-in "wxme/cycle.rkt"
+                    [set-editor-get-file! wx:set-editor-get-file!]
+                    [set-editor-put-file! wx:set-editor-put-file!])
+         "lock.rkt"
+         "wx.rkt"
+         "cycle.rkt"
+         "check.rkt"
+         "mrtop.rkt"
+         "path-dialog.rkt")
 
-  (provide get-file
-           get-file-list
-           put-file
-           get-directory)
+(provide get-file
+         get-file-list
+         put-file
+         get-directory)
 
-  (define (mk-file-selector who put? multi? dir?)
-    (lambda (message parent directory filename extension style filters)
-      ;; Calls from C++ have wrong kind of window:
-      (when (is-a? parent wx:window%)
-	(set! parent (as-entry (lambda () (wx->mred parent)))))
+(define ((mk-file-selector who put? multi? dir?)
+         message parent directory filename extension style filters dialog-mixin)
+  ;; Calls from C++ have wrong kind of window:
+  (when (is-a? parent wx:window%)
+    (set! parent (as-entry (λ () (wx->mred parent)))))
+  
+  (check-label-string/false who message)
+  (check-top-level-parent/false who parent)
+  (check-path/false who directory)
+  (check-path/false who filename)
+  (check-string/false who extension)
+  (check-style who #f (cond
+                        [dir? '(common enter-packages)]
+                        [else '(common packages enter-packages)]) style)
+  (unless (and (list? filters)
+               (andmap (λ (p)
+                         (and (list? p)
+                              (= (length p) 2)
+                              (string? (car p))
+                              (string? (cadr p))))
+                       filters))
+    (raise-type-error who "list of 2-string lists" filters))
+  (let* ([std? (memq 'common style)]
+         [style (if std? (remq 'common style) style)])
+    (if std?
+        (send (new (dialog-mixin path-dialog%)
+                   [put?      put?]
+                   [dir?      dir?]
+                   [multi?    multi?]
+                   [message   message]
+                   [parent    parent]
+                   [directory directory]
+                   [filename  filename]
+                   [filters
+                    (cond [(eq? filters default-filters) #t] ; its own defaults
+                          [dir? #f]
+                          [else filters])])
+              run)
+        (wx:file-selector
+         message directory filename extension
+         ;; file types:
+         filters
+         ;; style:
+         (cons (cond [dir?   'dir]
+                     [put?   'put]
+                     [multi? 'multi]
+                     [else   'get])
+               style)
+         ;; parent:
+         (and parent (mred->wx parent))))))
 
-      (check-label-string/false who message)
-      (check-top-level-parent/false who parent)
-      (check-path/false who directory)
-      (check-path/false who filename)
-      (check-string/false who extension)
-      (check-style who #f (cond
-			   [dir? '(common enter-packages)]
-			   [else '(common packages enter-packages)]) style)
-      (unless (and (list? filters)
-		   (andmap (lambda (p)
-			     (and (list? p)
-				  (= (length p) 2)
-				  (string? (car p))
-				  (string? (cadr p))))
-			   filters))
-	(raise-type-error who "list of 2-string lists" filters))
-      (let* ([std? (memq 'common style)]
-             [style (if std? (remq 'common style) style)])
-        (if std?
-          (send (new path-dialog%
-                  [put?      put?]
-                  [dir?      dir?]
-                  [multi?    multi?]
-                  [message   message]
-                  [parent    parent]
-                  [directory directory]
-                  [filename  filename]
-                  [filters
-                   (cond [(eq? filters default-filters) #t] ; its own defaults
-                         [dir? #f]
-                         [else filters])])
-                run)
-          (wx:file-selector
-           message directory filename extension
-           ;; file types:
-           filters
-           ;; style:
-           (cons (cond [dir?   'dir]
-                       [put?   'put]
-                       [multi? 'multi]
-                       [else   'get])
-                 style)
-           ;; parent:
-           (and parent (mred->wx parent)))))))
+(define default-filters '(("Any" "*.*")))
 
-  (define default-filters '(("Any" "*.*")))
+;; We duplicate the definition for `get-file', `get-file-list', and
+;; `put-file' so that they have the right arities and names
 
-  ;; We duplicate the case-lambda for `get-file', `get-file-list', and
-  ;; `put-file' so that they have the right arities and names
+(define-syntax define-file-selector
+  (syntax-rules ()
+    [(_ name put? multi?)
+     (define (name [message #f] [parent #f] [directory #f] [filename #f]
+                   [extension #f] [style null] [filters default-filters]
+                   #:dialog-mixin [dialog-mixin values])
+       ((mk-file-selector 'name put? multi? #f)
+        message parent directory filename extension style filters dialog-mixin))]))
 
-  (define-syntax define-file-selector
-    (syntax-rules ()
-      [(_ name put? multi?)
-       (define name
-         (opt-lambda ([message #f] [parent #f] [directory #f] [filename #f]
-                      [extension #f] [style null] [filters default-filters])
-           ((mk-file-selector 'name put? multi? #f)
-            message parent directory filename extension style filters)))]))
+(define-file-selector get-file      #f #f)
+(define-file-selector get-file-list #f #t)
+(define-file-selector put-file      #t #f)
 
-  (define-file-selector get-file      #f #f)
-  (define-file-selector get-file-list #f #t)
-  (define-file-selector put-file      #t #f)
+(define (get-directory [message #f] [parent #f] [directory #f] [style null] #:dialog-mixin [dialog-mixin values])
+  ((mk-file-selector 'get-directory #f #f #t)
+   message parent directory #f #f style null dialog-mixin))
 
-  (define get-directory
-    (opt-lambda ([message #f] [parent #f] [directory #f] [style null])
-      ((mk-file-selector 'get-directory #f #f #t)
-       message parent directory #f #f style null)))
-
-  (set-get-file! get-file)
-  (wx:set-editor-get-file! get-file)
-  (wx:set-editor-put-file! put-file))
+(set-get-file! get-file)
+(wx:set-editor-get-file! get-file)
+(wx:set-editor-put-file! put-file)
diff --git a/collects/mred/private/messagebox.rkt b/collects/mred/private/messagebox.rkt
index a9eb6d09a5..56b9c430c1 100644
--- a/collects/mred/private/messagebox.rkt
+++ b/collects/mred/private/messagebox.rkt
@@ -1,9 +1,8 @@
-(module messagebox mzscheme
+#lang racket/base
   (require mzlib/class
            mzlib/class100
-           mzlib/etc
            mzlib/string
-           (prefix wx: "kernel.rkt")
+           (prefix-in wx: "kernel.rkt")
            "const.rkt"
            "check.rkt"
            "helper.rkt"
@@ -24,7 +23,8 @@
     (lambda (who title message
 		 button1 button2 button3
 		 parent style close-result
-		 check? two-results? check-message)
+		 check? two-results? check-message
+                 dialog-mixin)
       (check-label-string who title)
       (check-string/false who message)
       (when check?
@@ -46,7 +46,8 @@
                    who title message
                    button1 button2 button3
                    parent style close-result
-                   check? two-results? check-message))]
+                   check? two-results? check-message
+                   dialog-mixin))]
 	    [es (if parent
 		    (send parent get-eventspace)
 		    (wx:current-eventspace))])
@@ -65,51 +66,53 @@
     (lambda (who title message
 		 button1 button2 button3
 		 parent style close-result
-		 check? two-results? check-message)
+		 check? two-results? check-message 
+                 dialog-mixin)
       (let* ([strings (regexp-split #rx"\n" message)]
 	     [single? (and (< (length strings) 10) 
 			   (andmap (lambda (s) (< (string-length s) 60)) strings))]
-	     [f (make-object (class100 dialog% ()
-			       (public
-				 [get-message
-				  (lambda () message)])
-			       (augment
-				[can-close? (lambda ()
-					      (if (memq 'disallow-close style)
-						  (begin
-						    (wx:bell)
-						    #f)
-						  #t))])
-			       (override
-				 [on-subwindow-event 
-				  (lambda (w e)
-				    (if (send e button-down?)
-					(if (is-a? w button%)
-					    #f
-					    (if (or (is-a? w message%)
-						    (and
-						     (is-a? w editor-canvas%)
-						     (let-values ([(w h) (send w get-client-size)])
-						       (< (send e get-x) w))))
-						(begin
-						  (send w popup-menu
-							(let ([m (make-object popup-menu%)])
-							  (make-object menu-item%
-								       "Copy Message"
-								       m
-								       (lambda (i e)
-									 (send (wx:get-the-clipboard)
-									       set-clipboard-string
-									       message
-									       (send e get-time-stamp))))
-							  m)
-							(send e get-x)
-							(send e get-y))
-						  #t)
-						#f))
-					#f))])
-			       (sequence
-				 (super-init title parent box-width))))]
+             [f (make-object (dialog-mixin
+                              (class100 dialog% ()
+                                (public
+                                  [get-message
+                                   (lambda () message)])
+                                (augment
+                                 [can-close? (lambda ()
+                                               (if (memq 'disallow-close style)
+                                                   (begin
+                                                     (wx:bell)
+                                                     #f)
+                                                   #t))])
+                                (override
+                                  [on-subwindow-event 
+                                   (lambda (w e)
+                                     (if (send e button-down?)
+                                         (if (is-a? w button%)
+                                             #f
+                                             (if (or (is-a? w message%)
+                                                     (and
+                                                      (is-a? w editor-canvas%)
+                                                      (let-values ([(w h) (send w get-client-size)])
+                                                        (< (send e get-x) w))))
+                                                 (begin
+                                                   (send w popup-menu
+                                                         (let ([m (make-object popup-menu%)])
+                                                           (make-object menu-item%
+                                                             "Copy Message"
+                                                             m
+                                                             (lambda (i e)
+                                                               (send (wx:get-the-clipboard)
+                                                                     set-clipboard-string
+                                                                     message
+                                                                     (send e get-time-stamp))))
+                                                           m)
+                                                         (send e get-x)
+                                                         (send e get-y))
+                                                   #t)
+                                                 #f))
+                                         #f))])
+                                (sequence
+                                  (super-init title parent box-width)))))]
 	     [result close-result]
 	     [icon-id (cond
 		       [(memq 'stop style) 'stop]
@@ -224,20 +227,21 @@
 		result))))))
 
   (define message-box/custom
-    (opt-lambda (title message 
-		       button1
-		       button2
-		       button3
-		       [parent #f]
-		       [style '(no-default)]
-		       [close-result #f])
+    (lambda (title message 
+                   button1
+                   button2
+                   button3
+                   [parent #f]
+                   [style '(no-default)]
+                   [close-result #f]
+                   #:dialog-mixin [dialog-mixin values])
       (do-message-box/custom 'message-box/custom
 			     title message button1 button2 button3
 			     parent style close-result
-			     #f #f #f)))
+			     #f #f #f dialog-mixin)))
 
   (define do-message-box
-    (lambda (who title message parent style check? check-message)
+    (lambda (who title message parent style check? check-message dialog-mixin)
       (check-label-string who title)
       (check-string/false who message)
       (when check?
@@ -276,7 +280,8 @@
 						  (list default)
 						  (list default 'disallow-close)))
 					     close-val
-					     check? #t check-message)])
+					     check? #t check-message
+                                             dialog-mixin)])
 	  (let ([result (case result
 			  [(1) one-v]
 			  [(2) two-v])])
@@ -285,23 +290,25 @@
 		result))))))
 
   (define message-box
-    (opt-lambda (title message [parent #f] [style '(ok)])
-      (do-message-box 'message-box title message parent style #f #f)))
+    (lambda (title message [parent #f] [style '(ok)] #:dialog-mixin [dialog-mixin values])
+      (do-message-box 'message-box title message parent style #f #f dialog-mixin)))
 
   (define message+check-box/custom
-    (opt-lambda (title message 
+    (lambda (title message 
 		       checkbox-message
 		       button1
 		       button2
 		       button3
 		       [parent #f]
 		       [style '(no-default)]
-		       [close-result #f])
+		       [close-result #f]
+                       #:dialog-mixin [dialog-mixin values])
       (do-message-box/custom 'message+check-box/custom
 			     title message button1 button2 button3
-			     parent style close-result
-			     #t #t checkbox-message)))
+                             parent style close-result
+			     #t #t checkbox-message
+                             dialog-mixin)))
 
   (define message+check-box
-    (opt-lambda (title message check-message [parent #f] [style '(ok)])
-      (do-message-box 'message-box title message parent style #t check-message))))
+    (lambda (title message check-message [parent #f] [style '(ok)] #:dialog-mixin [dialog-mixin values])
+      (do-message-box 'message-box title message parent style #t check-message dialog-mixin)))
diff --git a/collects/mred/private/moredialogs.rkt b/collects/mred/private/moredialogs.rkt
index 201f620a23..e732d28d69 100644
--- a/collects/mred/private/moredialogs.rkt
+++ b/collects/mred/private/moredialogs.rkt
@@ -1,19 +1,14 @@
-(module moredialogs mzscheme
-  (require mzlib/class
-           mzlib/etc
-           mzlib/list
-           (prefix wx: "kernel.rkt")
-           (prefix wx: racket/snip)
+#lang racket/base
+  (require racket/class
+           (prefix-in wx: "kernel.rkt")
+           (prefix-in wx: racket/snip)
            "lock.rkt"
            "const.rkt"
            "check.rkt"
            "wx.rkt"
            "helper.rkt"
-           "editor.rkt"
            "mrtop.rkt"
            "mrcanvas.rkt"
-           "mrpopup.rkt"
-           "mrmenu.rkt"
            "mritem.rkt"
            "mrpanel.rkt"
            "mrtextfield.rkt")
@@ -190,34 +185,33 @@
   (define (can-get-page-setup-from-user?)
     (wx:can-show-print-setup?))
 
-  (define get-text-from-user
-    (case-lambda
-     [(title message) (get-text-from-user title message #f "" null)]
-     [(title message parent) (get-text-from-user title message parent "" null)]
-     [(title message parent init-val) (get-text-from-user title message parent init-val null)]
-     [(title message parent init-val style)
-      (check-label-string 'get-text-from-user title)
-      (check-label-string/false 'get-text-from-user message)
-      (check-top-level-parent/false 'get-text-from-user parent)
-      (check-string 'get-text-from-user init-val)
-      (check-style 'get-text-from-user #f '(password) style)
-      (let* ([f (make-object dialog% title parent box-width)]
-	     [ok? #f]
-	     [done (lambda (?) (lambda (b e) (set! ok? ?) (send f show #f)))])
-	(let ([t (make-object text-field% message f (lambda (t e) (when (eq? (send e get-event-type) 'text-field-enter)
-								    ((done #t) #f #f)))
-			      init-val (list* 'single 'vertical-label style))]
-	      [p (make-object horizontal-pane% f)])
-          (send p set-alignment 'right 'center)
-	  (send f stretchable-height #f)
-          (ok-cancel
-           (lambda () (make-object button% "OK" p (done #t) '(border)))
-           (lambda () (make-object button% "Cancel" p (done #f))))
-	  (send (send t get-editor) select-all)
-	  (send t focus)
-	  (send f center)
-	  (send f show #t)
-	  (and ok? (send t get-value))))]))
+  (define (get-text-from-user title message
+                              [parent #f]
+                              [init-val ""]
+                              [style null]
+                              #:dialog-mixin [dialog-mixin values])
+    (check-label-string 'get-text-from-user title)
+    (check-label-string/false 'get-text-from-user message)
+    (check-top-level-parent/false 'get-text-from-user parent)
+    (check-string 'get-text-from-user init-val)
+    (check-style 'get-text-from-user #f '(password) style)
+    (define f (make-object (dialog-mixin dialog%) title parent box-width))
+    (define ok? #f)
+    (define ((done ?) b e) (set! ok? ?) (send f show #f))
+    (define t (make-object text-field% message f (lambda (t e) (when (eq? (send e get-event-type) 'text-field-enter)
+                                                                 ((done #t) #f #f)))
+                init-val (list* 'single 'vertical-label style)))
+    (define p (make-object horizontal-pane% f))
+    (send p set-alignment 'right 'center)
+    (send f stretchable-height #f)
+    (ok-cancel
+     (lambda () (make-object button% "OK" p (done #t) '(border)))
+     (lambda () (make-object button% "Cancel" p (done #f))))
+    (send (send t get-editor) select-all)
+    (send t focus)
+    (send f center)
+    (send f show #t)
+    (and ok? (send t get-value)))
 
   (define get-choices-from-user
     (case-lambda
@@ -347,4 +341,4 @@
 	    (send f center)
 	    (send f show #t)
 	    (and ok?
-                 (get-current-color))))])))
+                 (get-current-color))))]))
diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt
index dc54e9d969..ef26252a88 100644
--- a/collects/mred/private/wx/cocoa/frame.rkt
+++ b/collects/mred/private/wx/cocoa/frame.rkt
@@ -86,6 +86,19 @@
         (when wxb
           (let ([wx (->wx wxb)])
             (when wx
+              ;; Sometimes, a sheet becomes the main window and the parent
+              ;; still thinks that the parent is the main window. Tell
+              ;; the parent otherwise.
+              (let ([p (send wx get-parent)])
+                (when p
+                  (let ([s (send p get-sheet)])
+                    (when (eq? s wx)
+                      (let ([parent (send p get-cocoa)])
+                        (when (tell #:type _BOOL parent isMainWindow)
+                          ;; The Cocoa docs say never to call this method directly,
+                          ;; but we're trying to fix up a case where Cocoa seems
+                          ;; to be confused:
+                          (tellv parent resignMainWindow)))))))
               (set! front wx)
               (send wx install-wait-cursor)
               (send wx install-mb)
@@ -344,7 +357,8 @@
     (define/public (force-window-focus)
       (let ([next (get-app-front-window)])
         (cond
-         [next (tellv next makeKeyWindow)]
+         [next 
+          (tellv next makeKeyWindow)]          
          [root-fake-frame 
           ;; Make key focus shift to root frame:
           (let ([root-cocoa (send root-fake-frame get-cocoa)])
diff --git a/collects/mred/private/wx/cocoa/menu-bar.rkt b/collects/mred/private/wx/cocoa/menu-bar.rkt
index c16e81cfea..80350fc89d 100644
--- a/collects/mred/private/wx/cocoa/menu-bar.rkt
+++ b/collects/mred/private/wx/cocoa/menu-bar.rkt
@@ -108,7 +108,7 @@
                                               app))
                    (tellv apple addItem: item)
                    (tellv item release)))])
-      (std (format "About ~a" app-name) (selector orderFrontStandardAboutPanel:))
+      (std (format "About ~a" app-name) (selector openAbout:) "" #f #t)
       (std "Preferences..."  (selector openPreferences:) "," #f #t)
       (tellv apple addItem: (tell NSMenuItem separatorItem))
       (let ([services (tell (tell NSMenu alloc) initWithTitle: #:type _NSString "Services")])
diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt
index 04614d67f1..672c4ffc99 100644
--- a/collects/mred/private/wx/cocoa/queue.rkt
+++ b/collects/mred/private/wx/cocoa/queue.rkt
@@ -56,10 +56,21 @@
       (queue-prefs-event)
       #t]
   [-a _BOOL (validateMenuItem: [_id menuItem])
-      (if (ptr-equal? (selector openPreferences:) 
-                      (tell #:type _SEL menuItem action))
-          (not (eq? (application-pref-handler) nothing-application-pref-handler))
-          (super-tell #:type _BOOL validateMenuItem: menuItem))]
+      (cond 
+       [(ptr-equal? (selector openPreferences:) 
+                    (tell #:type _SEL menuItem action))
+        (not (eq? (application-pref-handler) nothing-application-pref-handler))]
+       [(ptr-equal? (selector openAbout:) 
+                    (tell #:type _SEL menuItem action))
+        #t]
+       [else
+        (super-tell #:type _BOOL validateMenuItem: menuItem)])]
+  [-a _BOOL (openAbout: [_id sender])
+      (if (eq? nothing-application-about-handler
+               (application-about-handler))
+          (tellv app orderFrontStandardAboutPanel: sender)
+          (queue-about-event))
+      #t]
   [-a _BOOL (application: [_id theApplication] openFile: [_NSString filename])
       (queue-file-event (string->path filename))]
   [-a _BOOL (applicationShouldHandleReopen: [_id app] hasVisibleWindows: [_BOOL has-visible?])
@@ -82,15 +93,17 @@
 ;; explicitly register with the dock so the application can receive
 ;; keyboard events.
 (define-cstruct _ProcessSerialNumber
-  ([highLongOfPSN _ulong]
-   [lowLongOfPSN _ulong]))
+  ([highLongOfPSN _uint32]
+   [lowLongOfPSN _uint32]))
 (define kCurrentProcess 2)
 (define kProcessTransformToForegroundApplication 1)
 (define-appserv TransformProcessType (_fun _ProcessSerialNumber-pointer
                                            _uint32
                                            -> _OSStatus))
-(void (TransformProcessType (make-ProcessSerialNumber 0 kCurrentProcess)
-                            kProcessTransformToForegroundApplication))
+(let ([v (TransformProcessType (make-ProcessSerialNumber 0 kCurrentProcess)
+                               kProcessTransformToForegroundApplication)])
+  (unless (zero? v)
+    (log-error (format "error from TransformProcessType: ~a" v))))
 
 (define app-delegate (tell (tell MyApplicationDelegate alloc) init))
 (tellv app setDelegate: app-delegate)
@@ -108,8 +121,9 @@
 (define-appserv CGDisplayRegisterReconfigurationCallback 
   (_fun (_fun #:atomic? #t -> _void) _pointer -> _int32))
 (define (on-screen-changed) (post-dummy-event))
-(void
- (CGDisplayRegisterReconfigurationCallback on-screen-changed #f))
+(let ([v (CGDisplayRegisterReconfigurationCallback on-screen-changed #f)])
+  (unless (zero? v)
+    (log-error (format "error from CGDisplayRegisterReconfigurationCallback: ~a" v))))
 
 (tellv app finishLaunching)
 
diff --git a/collects/mred/private/wx/common/handlers.rkt b/collects/mred/private/wx/common/handlers.rkt
index 3776fd014b..b62ea90170 100644
--- a/collects/mred/private/wx/common/handlers.rkt
+++ b/collects/mred/private/wx/common/handlers.rkt
@@ -6,7 +6,8 @@
               application-about-handler
               application-pref-handler
               
-              nothing-application-pref-handler))
+              nothing-application-pref-handler
+              nothing-application-about-handler))
 
 (define saved-files null)
 (define afh (lambda (f)
@@ -26,7 +27,8 @@
    [(proc) (set! aqh proc)]
    [() aqh]))
 
-(define aah void)
+(define (nothing-application-about-handler) (void))
+(define aah nothing-application-about-handler)
 (define application-about-handler
   (case-lambda
    [(proc) (set! aah proc)]
diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt
index 773e327380..f887785414 100644
--- a/collects/mred/private/wx/common/queue.rkt
+++ b/collects/mred/private/wx/common/queue.rkt
@@ -54,6 +54,7 @@
 
               queue-quit-event
               queue-prefs-event
+              queue-about-event
               queue-file-event
 
               begin-busy-cursor
@@ -571,6 +572,10 @@
   ;; called in event-pump thread
   (queue-event main-eventspace (application-pref-handler) 'med))
 
+(define (queue-about-event)
+  ;; called in event-pump thread
+  (queue-event main-eventspace (application-about-handler) 'med))
+
 (define (queue-file-event file)
   ;; called in event-pump thread
   (queue-event main-eventspace (lambda ()
diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index 0091e46230..abe4cff19c 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -280,7 +280,8 @@
               (unless (eq? client-gtk container-gtk)
                 (gtk_fixed_set_has_window client-gtk #t)) ; imposes clipping
               (when has-border?
-                (gtk_container_set_border_width h margin))
+                (gtk_container_set_border_width h margin)
+                (connect-expose-border h))
               (gtk_box_pack_start h v #t #t 0)
               (gtk_box_pack_start v client-gtk #t #t 0)
               (gtk_box_pack_start h v2 #f #f 0)
diff --git a/collects/mred/private/wx/gtk/list-box.rkt b/collects/mred/private/wx/gtk/list-box.rkt
index c112f034c4..1979099635 100644
--- a/collects/mred/private/wx/gtk/list-box.rkt
+++ b/collects/mred/private/wx/gtk/list-box.rkt
@@ -211,7 +211,7 @@
              [font font]
              [no-show? (memq 'deleted style)])
 
-  (set-auto-size)
+  (set-auto-size 32) ; 32 is extra width
 
   (connect-changed selection)
   (connect-activated client-gtk)
diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt
index 7402c4bbc6..78f93bfee2 100644
--- a/collects/mred/private/wx/gtk/menu.rkt
+++ b/collects/mred/private/wx/gtk/menu.rkt
@@ -181,25 +181,27 @@
               (unless (unbox cnb) 
                 (cb this e)))))))
   
-  (define/private (adjust-shortcut item-gtk title)
+  (define/private (adjust-shortcut item-gtk title need-clear?)
     (let ([m (regexp-match #rx"\t(Ctrl[+])?(Shift[+])?(Meta[+])?(Alt[+])?(.|[0-9]+)$" 
                            title)])
-      (when m
-        (let ([mask (+ (if (list-ref m 1) GDK_CONTROL_MASK 0)
-                       (if (list-ref m 2) GDK_SHIFT_MASK 0)
-                       (if (list-ref m 3) GDK_MOD1_MASK 0)
-                       (if (list-ref m 4) GDK_META_MASK 0))]
-              [code (let ([s (list-ref m 5)])
-                      (if (= 1 (string-length s))
-                          (gdk_unicode_to_keyval 
-                           (char->integer (string-ref s 0)))
-                          (string->number s)))])
-          (unless (zero? code)
-            (let ([accel-path (format "<GRacket>/Hardwired/~a" title)])
-              (gtk_accel_map_add_entry accel-path
-                                       code
-                                       mask)
-              (gtk_menu_item_set_accel_path item-gtk accel-path)))))))
+      (if m
+          (let ([mask (+ (if (list-ref m 1) GDK_CONTROL_MASK 0)
+                         (if (list-ref m 2) GDK_SHIFT_MASK 0)
+                         (if (list-ref m 3) GDK_MOD1_MASK 0)
+                         (if (list-ref m 4) GDK_META_MASK 0))]
+                [code (let ([s (list-ref m 5)])
+                        (if (= 1 (string-length s))
+                            (gdk_unicode_to_keyval 
+                             (char->integer (string-ref s 0)))
+                            (string->number s)))])
+            (unless (zero? code)
+              (let ([accel-path (format "<GRacket>/Hardwired/~a" title)])
+                (gtk_accel_map_add_entry accel-path
+                                         code
+                                         mask)
+                (gtk_menu_item_set_accel_path item-gtk accel-path))))
+          (when need-clear?
+            (gtk_menu_item_set_accel_path item-gtk #f)))))
   
   (public [append-item append])
   (define (append-item i label help-str-or-submenu chckable?)
@@ -226,7 +228,7 @@
                             [menu-item i]
                             [parent this])])
              (set! items (append items (list (list item item-gtk label chckable?))))
-             (adjust-shortcut item-gtk label)))
+             (adjust-shortcut item-gtk label #f)))
        (gtk_menu_shell_append gtk item-gtk)
        (gtk_widget_show item-gtk))))
 
@@ -258,7 +260,8 @@
     (let ([gtk (find-gtk item)])
       (when gtk
         (gtk_label_set_text_with_mnemonic (gtk_bin_get_child gtk) 
-                                          (fixup-mnemonic str)))))
+                                          (fixup-mnemonic str))
+        (adjust-shortcut gtk str #t))))
 
   (define/public (enable item on?)
     (let ([gtk (find-gtk item)])
diff --git a/collects/mred/private/wx/gtk/panel.rkt b/collects/mred/private/wx/gtk/panel.rkt
index 566d601b8a..8fe82e7161 100644
--- a/collects/mred/private/wx/gtk/panel.rkt
+++ b/collects/mred/private/wx/gtk/panel.rkt
@@ -35,14 +35,16 @@
            [gray #x8000])
       (when gc
         (gdk_gc_set_rgb_fg_color gc (make-GdkColor 0 gray gray gray))
-        (let ([a (widget-allocation gtk)]
-              [no-window? (not (zero? (bitwise-and (get-gtk-object-flags gtk)
-                                                   GTK_NO_WINDOW)))])
-          (gdk_draw_rectangle win gc #f
-                              (if no-window? (GtkAllocation-x a) 0)
-                              (if no-window? (GtkAllocation-y a) 0)
-                              (sub1 (GtkAllocation-width a))
-                              (sub1 (GtkAllocation-height a))))
+        (let* ([a (widget-allocation gtk)]
+               [w (sub1 (GtkAllocation-width a))]
+               [h (sub1 (GtkAllocation-height a))])
+          (let loop ([gtk gtk] [x 0] [y 0])
+            (if (not (zero? (bitwise-and (get-gtk-object-flags gtk) GTK_NO_WINDOW)))
+                ;; no window:
+                (let ([a (widget-allocation gtk)])
+                  (loop (widget-parent gtk) (+ x (GtkAllocation-x a)) (+ y (GtkAllocation-y a))))
+                ;; found window:
+                (gdk_draw_rectangle win gc #f x y w h))))
         (gdk_gc_unref gc)))
     #f))
 
diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt
index 9bbca2874f..5055347404 100644
--- a/collects/mred/private/wx/gtk/window.rkt
+++ b/collects/mred/private/wx/gtk/window.rkt
@@ -42,6 +42,7 @@
 
               widget-window
               widget-allocation
+              widget-parent
 
               the-accelerator-group
               gtk_window_add_accel_group
@@ -105,6 +106,9 @@
 (define (widget-window gtk)
   (GtkWidgetT-window (cast gtk _GtkWidget _GtkWidgetT-pointer)))
 
+(define (widget-parent gtk)
+  (GtkWidgetT-parent (cast gtk _GtkWidget _GtkWidgetT-pointer)))
+
 (define (widget-allocation gtk)
   (GtkWidgetT-alloc (cast gtk _GtkWidget _GtkWidgetT-pointer)))
 
@@ -506,13 +510,13 @@
           (set! client-delta-h (- (GtkRequisition-height req)
                                   (GtkRequisition-height creq))))))
 
-    (define/public (set-auto-size)
+    (define/public (set-auto-size [dw 0] [dh 0])
       (let ([req (make-GtkRequisition 0 0)])
         (gtk_widget_size_request gtk req)
         (set-size -11111
                   -11111
-                  (GtkRequisition-width req)
-                  (GtkRequisition-height req))))
+                  (+ (GtkRequisition-width req) dw)
+                  (+ (GtkRequisition-height req) dh))))
 
     (define shown? #f)
     (define/public (direct-show on?)
diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt
index 01f022c2c8..dcbc91b0d1 100644
--- a/collects/mred/private/wx/win32/canvas.rkt
+++ b/collects/mred/private/wx/win32/canvas.rkt
@@ -242,7 +242,7 @@
      (define/override (on-resized)
        (reset-dc))
 
-     (define/private (reset-dc)
+     (define/private (reset-dc [refresh? #t])
        (send dc reset-backing-retained)
        (send dc set-auto-scroll
              (if (get-virtual-width)
@@ -250,16 +250,8 @@
                  0)
              (if (get-virtual-height)
                  (get-virtual-v-pos)
-                 0)))
-
-     (define/public (tell-me-what)
-       (let ([r (GetClientRect (get-client-hwnd))]
-             [rr (GetWindowRect (get-hwnd))])
-         (printf "~s\n"
-                 (list hscroll? vscroll?
-                       (list (RECT-left r) (RECT-top r) (RECT-right r) (RECT-bottom r))
-                       (list (RECT-left rr) (RECT-top rr) (RECT-right rr) (RECT-bottom rr))))))
-
+                 0))
+       (when refresh? (refresh-one)))
 
      (define/override (show-children)
        (when (dc . is-a? . dc<%>)
diff --git a/collects/mzlib/include.rkt b/collects/mzlib/include.rkt
index 356f3260b1..350efea469 100644
--- a/collects/mzlib/include.rkt
+++ b/collects/mzlib/include.rkt
@@ -20,7 +20,10 @@
 		   fn))
 		(string->path s))]
 	     [(-build-path elem ...)
-	      (module-or-top-identifier=? #'-build-path build-path-stx)
+              (begin
+                (collect-garbage)
+                (module-identifier=? #'-build-path build-path-stx)
+                (module-or-top-identifier=? #'-build-path build-path-stx))
 	      (let ([l (syntax-object->datum (syntax (elem ...)))])
 		(when (null? l)
 		  (raise-syntax-error
diff --git a/collects/mzlib/scribblings/pconvert.scrbl b/collects/mzlib/scribblings/pconvert.scrbl
index 74e9db4bfb..a6b32b4a04 100644
--- a/collects/mzlib/scribblings/pconvert.scrbl
+++ b/collects/mzlib/scribblings/pconvert.scrbl
@@ -230,7 +230,7 @@ conversion when the value of @racket[constructor-style-printing] is
 @racket[#f]. If @racket[quasi-read-style-printing] is set to
 @racket[#f], then boxes and vectors are unquoted and represented using
 constructors. For example, the list of a box containing the number 1
-and a vector containing the number 1 is represented as @racket[`(,(box
+and a vector containing the number 1 is represented as @racketresult[`(,(box
 1) ,(vector 1))]. If the parameter's value is @racket[#t], then
 @racket[#&....]  and @racket[#(....)] are used, e.g., @racket[`(#&1
 #(1))].  The initial value of the parameter is @racket[#t].}
diff --git a/collects/net/base64-unit.rkt b/collects/net/base64-unit.rkt
index 8fc1d28dbd..6fa00d416d 100644
--- a/collects/net/base64-unit.rkt
+++ b/collects/net/base64-unit.rkt
@@ -1,67 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require "base64-sig.rkt")
+(require racket/unit
+         "base64-sig.rkt" "base64.rkt")
 
-(import)
-(export base64^)
+(define-unit-from-context base64@ base64^)
 
-(define ranges '([#"AZ" 0] [#"az" 26] [#"09" 52] [#"++" 62] [#"//" 63]))
-
-(define-values (base64-digit digit-base64)
-  (let ([bd (make-vector 256 #f)] [db (make-vector 64 #f)])
-    (for ([r ranges] #:when #t
-          [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))]
-          [n (in-naturals (cadr r))])
-      (vector-set! bd i n)
-      (vector-set! db n i))
-    (values (vector->immutable-vector bd) (vector->immutable-vector db))))
-
-(define =byte (bytes-ref #"=" 0))
-(define ones
-  (vector->immutable-vector
-   (list->vector (for/list ([i (in-range 9)]) (sub1 (arithmetic-shift 1 i))))))
-
-(define (base64-decode-stream in out)
-  (let loop ([data 0] [bits 0])
-    (if (>= bits 8)
-      (let ([bits (- bits 8)])
-        (write-byte (arithmetic-shift data (- bits)) out)
-        (loop (bitwise-and data (vector-ref ones bits)) bits))
-      (let ([c (read-byte in)])
-        (unless (or (eof-object? c) (eq? c =byte))
-          (let ([v (vector-ref base64-digit c)])
-            (if v
-              (loop (+ (arithmetic-shift data 6) v) (+ bits 6))
-              (loop data bits))))))))
-
-(define (base64-encode-stream in out [linesep #"\n"])
-  (let loop ([data 0] [bits 0] [width 0])
-    (define (write-char)
-      (write-byte (vector-ref digit-base64 (arithmetic-shift data (- 6 bits)))
-                  out)
-      (let ([width (modulo (add1 width) 72)])
-        (when (zero? width) (display linesep out))
-        width))
-    (if (>= bits 6)
-      (let ([bits (- bits 6)])
-        (loop (bitwise-and data (vector-ref ones bits)) bits (write-char)))
-      (let ([c (read-byte in)])
-        (if (eof-object? c)
-          ;; flush extra bits
-          (begin
-            (let ([width (if (> bits 0) (write-char) width)])
-              (when (> width 0)
-                (for ([i (in-range (modulo (- width) 4))])
-                  (write-byte =byte out))
-                (display linesep out))))
-          (loop (+ (arithmetic-shift data 8) c) (+ bits 8) width))))))
-
-(define (base64-decode src)
-  (let ([s (open-output-bytes)])
-    (base64-decode-stream (open-input-bytes src) s)
-    (get-output-bytes s)))
-
-(define (base64-encode src)
-  (let ([s (open-output-bytes)])
-    (base64-encode-stream (open-input-bytes src) s (bytes 13 10))
-    (get-output-bytes s)))
+(provide base64@)
diff --git a/collects/net/base64.rkt b/collects/net/base64.rkt
index b9a84cf1b3..087c927d8c 100644
--- a/collects/net/base64.rkt
+++ b/collects/net/base64.rkt
@@ -1,6 +1,67 @@
 #lang racket/base
-(require racket/unit "base64-sig.rkt" "base64-unit.rkt")
 
-(define-values/invoke-unit/infer base64@)
+(provide base64-encode-stream
+         base64-decode-stream
+         base64-encode
+         base64-decode)
 
-(provide-signature-elements base64^)
+(define ranges '([#"AZ" 0] [#"az" 26] [#"09" 52] [#"++" 62] [#"//" 63]))
+
+(define-values (base64-digit digit-base64)
+  (let ([bd (make-vector 256 #f)] [db (make-vector 64 #f)])
+    (for ([r ranges] #:when #t
+          [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))]
+          [n (in-naturals (cadr r))])
+      (vector-set! bd i n)
+      (vector-set! db n i))
+    (values (vector->immutable-vector bd) (vector->immutable-vector db))))
+
+(define =byte (bytes-ref #"=" 0))
+(define ones
+  (vector->immutable-vector
+   (list->vector (for/list ([i (in-range 9)]) (sub1 (arithmetic-shift 1 i))))))
+
+(define (base64-decode-stream in out)
+  (let loop ([data 0] [bits 0])
+    (if (>= bits 8)
+      (let ([bits (- bits 8)])
+        (write-byte (arithmetic-shift data (- bits)) out)
+        (loop (bitwise-and data (vector-ref ones bits)) bits))
+      (let ([c (read-byte in)])
+        (unless (or (eof-object? c) (eq? c =byte))
+          (let ([v (vector-ref base64-digit c)])
+            (if v
+              (loop (+ (arithmetic-shift data 6) v) (+ bits 6))
+              (loop data bits))))))))
+
+(define (base64-encode-stream in out [linesep #"\n"])
+  (let loop ([data 0] [bits 0] [width 0])
+    (define (write-char)
+      (write-byte (vector-ref digit-base64 (arithmetic-shift data (- 6 bits)))
+                  out)
+      (let ([width (modulo (add1 width) 72)])
+        (when (zero? width) (display linesep out))
+        width))
+    (if (>= bits 6)
+      (let ([bits (- bits 6)])
+        (loop (bitwise-and data (vector-ref ones bits)) bits (write-char)))
+      (let ([c (read-byte in)])
+        (if (eof-object? c)
+          ;; flush extra bits
+          (begin
+            (let ([width (if (> bits 0) (write-char) width)])
+              (when (> width 0)
+                (for ([i (in-range (modulo (- width) 4))])
+                  (write-byte =byte out))
+                (display linesep out))))
+          (loop (+ (arithmetic-shift data 8) c) (+ bits 8) width))))))
+
+(define (base64-decode src)
+  (let ([s (open-output-bytes)])
+    (base64-decode-stream (open-input-bytes src) s)
+    (get-output-bytes s)))
+
+(define (base64-encode src)
+  (let ([s (open-output-bytes)])
+    (base64-encode-stream (open-input-bytes src) s (bytes 13 10))
+    (get-output-bytes s)))
diff --git a/collects/net/cgi-sig.rkt b/collects/net/cgi-sig.rkt
index 8e54485ed5..6ec6aacadc 100644
--- a/collects/net/cgi-sig.rkt
+++ b/collects/net/cgi-sig.rkt
@@ -20,4 +20,3 @@ get-cgi-method
 ;; -- general HTML utilities --
 string->html
 generate-link-text
-
diff --git a/collects/net/cgi-unit.rkt b/collects/net/cgi-unit.rkt
index 295836e9de..ac90c64e84 100644
--- a/collects/net/cgi-unit.rkt
+++ b/collects/net/cgi-unit.rkt
@@ -1,207 +1,8 @@
-#lang racket/unit
-(require "cgi-sig.rkt" "uri-codec.rkt")
+#lang racket/base
 
-(import)
-(export cgi^)
+(require racket/unit
+         "cgi-sig.rkt" "cgi.rkt")
 
-;; type bindings = list ((symbol . string))
+(define-unit-from-context cgi@ cgi^)
 
-;; --------------------------------------------------------------------
-
-;; Exceptions:
-
-(define-struct cgi-error ())
-
-;; chars : list (char)
-;; -- gives the suffix which is invalid, not including the `%'
-
-(define-struct (incomplete-%-suffix cgi-error) (chars))
-
-;; char : char
-;; -- an invalid character in a hex string
-
-(define-struct (invalid-%-suffix cgi-error) (char))
-
-;; --------------------------------------------------------------------
-
-;; query-string->string : string -> string
-
-;; -- The input is the string post-processed as per Web specs, which
-;; is as follows:
-;; spaces are turned into "+"es and lots of things are turned into %XX, where
-;; XX are hex digits, eg, %E7 for ~.  The output is a regular Scheme string
-;; with all the characters converted back.
-
-(define query-string->string form-urlencoded-decode)
-
-;; string->html : string -> string
-;; -- the input is raw text, the output is HTML appropriately quoted
-
-(define (string->html s)
-  (apply string-append
-         (map (lambda (c)
-                (case c
-                  [(#\<) "&lt;"]
-                  [(#\>) "&gt;"]
-                  [(#\&) "&amp;"]
-                  [else (string c)]))
-              (string->list s))))
-
-(define default-text-color  "#000000")
-(define default-bg-color    "#ffffff")
-(define default-link-color  "#cc2200")
-(define default-vlink-color "#882200")
-(define default-alink-color "#444444")
-
-;; generate-html-output :
-;; html-string x list (html-string) x ... -> ()
-
-(define (generate-html-output title body-lines
-                              [text-color default-text-color]
-                              [bg-color default-bg-color]
-                              [link-color default-link-color]
-                              [vlink-color default-vlink-color]
-                              [alink-color default-alink-color])
-  (let ([sa string-append])
-    (for ([l `("Content-type: text/html"
-               ""
-               "<html>"
-               "<!-- The form was processed, and this document was generated,"
-               "     using the CGI utilities for Racket.  For more information"
-               "     on Racket, see"
-               "       http://racket-lang.org/"
-               "     and for the CGI utilities, contact"
-               "     (sk@cs.brown.edu). -->"
-               "<head>"
-               ,(sa "<title>" title "</title>")
-               "</head>"
-               ""
-               ,(sa "<body bgcolor=\"" bg-color "\" text=\"" text-color "\"")
-               ,(sa "      link=\"" link-color "\"")
-               ,(sa "      vlink=\"" vlink-color "\" alink=\"" alink-color "\">")
-               ""
-               ,@body-lines
-               ""
-               "</body>"
-               "</html>")])
-      (display l)
-      (newline))))
-
-;; output-http-headers : -> void
-(define (output-http-headers)
-  (printf "Content-type: text/html\r\n\r\n"))
-
-;; delimiter->predicate : symbol -> regexp
-;; returns a regexp to read a chunk of text up to a delimiter (excluding it)
-(define (delimiter->rx delimiter)
-  (case delimiter
-    [(amp)         #rx#"^[^&]*"]
-    [(semi)        #rx#"^[^;]*"]
-    [(amp-or-semi) #rx#"^[^&;]*"]
-    [else (error 'delimiter->rx
-                 "internal-error, unknown delimiter: ~e" delimiter)]))
-
-;; get-bindings* : iport -> (listof (cons symbol string))
-;; Reads all bindings from the input port.  The strings are processed to
-;; remove the CGI spec "escape"s.
-;; This code is _slightly_ lax: it allows an input to end in
-;; (current-alist-separator-mode).  It's not clear this is legal by the
-;; CGI spec, which suggests that the last value binding must end in an
-;; EOF.  It doesn't look like this matters.
-;; ELI: * Keeping this behavior for now, maybe better to remove it?
-;;      * Looks like `form-urlencoded->alist' is doing almost exactly
-;;        the same job this code does.
-(define (get-bindings* method ip)
-  (define (err fmt . xs)
-    (generate-error-output
-     (list (format "Server generated malformed input for ~a method:" method)
-           (apply format fmt xs))))
-  (define value-rx (delimiter->rx (current-alist-separator-mode)))
-  (define (process str) (query-string->string (bytes->string/utf-8 str)))
-  (let loop ([bindings '()])
-    (if (eof-object? (peek-char ip))
-      (reverse bindings)
-      (let ()
-        (define name (car (or (regexp-match #rx"^[^=]+" ip)
-                              (err "Missing field name before `='"))))
-        (unless (eq? #\= (read-char ip))
-          (err "No binding for `~a' field." name))
-        (define value (car (regexp-match value-rx ip)))
-        (read-char ip) ; consume the delimiter, possibly eof (retested above)
-        (loop (cons (cons (string->symbol (process name)) (process value))
-                    bindings))))))
-
-;; get-bindings/post : () -> bindings
-(define (get-bindings/post)
-  (get-bindings* "POST" (current-input-port)))
-
-;; get-bindings/get : () -> bindings
-(define (get-bindings/get)
-  (get-bindings* "GET" (open-input-string (getenv "QUERY_STRING"))))
-
-;; get-bindings : () -> bindings
-(define (get-bindings)
-  (if (string=? (get-cgi-method) "POST")
-    (get-bindings/post)
-    (get-bindings/get)))
-
-;; generate-error-output : list (html-string) -> <exit>
-(define (generate-error-output error-message-lines)
-  (generate-html-output "Internal Error" error-message-lines)
-  (exit))
-
-;; bindings-as-html : bindings -> list (html-string)
-;; -- formats name-value bindings as HTML appropriate for displaying
-(define (bindings-as-html bindings)
-  `("<code>"
-    ,@(map (lambda (bind)
-             (string-append (symbol->string (car bind))
-                            "&nbsp;--&gt;&nbsp;"
-                            (cdr bind)
-                            "<br>"))
-           bindings)
-    "</code>"))
-
-;; extract-bindings : (string + symbol) x bindings -> list (string)
-;; -- Extracts the bindings associated with a given name.  The semantics of
-;; forms states that a CHECKBOX may use the same NAME field multiple times.
-;; Hence, a list of strings is returned.  Note that the result may be the
-;; empty list.
-(define (extract-bindings field-name bindings)
-  (let ([field-name (if (symbol? field-name)
-                      field-name (string->symbol field-name))])
-    (let loop ([found null] [bindings bindings])
-      (if (null? bindings)
-        found
-        (if (equal? field-name (caar bindings))
-          (loop (cons (cdar bindings) found) (cdr bindings))
-          (loop found (cdr bindings)))))))
-
-;; extract-binding/single : (string + symbol) x bindings -> string
-;; -- used in cases where only one binding is supposed to occur
-(define (extract-binding/single field-name bindings)
-  (let* ([field-name (if (symbol? field-name)
-                       field-name (string->symbol field-name))]
-         [result (extract-bindings field-name bindings)])
-    (cond
-      [(null? result)
-       (generate-error-output
-        (cons (format "No binding for field `~a':<br>" field-name)
-              (bindings-as-html bindings)))]
-      [(null? (cdr result))
-       (car result)]
-      [else
-       (generate-error-output
-        (cons (format "Multiple bindings for field `~a' where one expected:<br>"
-                      field-name)
-              (bindings-as-html bindings)))])))
-
-;; get-cgi-method : () -> string
-;; -- string is either GET or POST (though future extension is possible)
-(define (get-cgi-method)
-  (or (getenv "REQUEST_METHOD")
-      (error 'get-cgi-method "no REQUEST_METHOD environment variable")))
-
-;; generate-link-text : string x html-string -> html-string
-(define (generate-link-text url anchor-text)
-  (string-append "<a href=\"" url "\">" anchor-text "</a>"))
+(provide cgi@)
diff --git a/collects/net/cgi.rkt b/collects/net/cgi.rkt
index b848d16f0e..9612982942 100644
--- a/collects/net/cgi.rkt
+++ b/collects/net/cgi.rkt
@@ -1,6 +1,227 @@
 #lang racket/base
-(require racket/unit "cgi-sig.rkt" "cgi-unit.rkt")
 
-(define-values/invoke-unit/infer cgi@)
+(require "uri-codec.rkt")
 
-(provide-signature-elements cgi^)
+(provide
+ ;; -- exceptions raised --
+ (struct-out cgi-error)
+ (struct-out incomplete-%-suffix)
+ (struct-out invalid-%-suffix)
+
+ ;; -- cgi methods --
+ get-bindings
+ get-bindings/post
+ get-bindings/get
+ output-http-headers
+ generate-html-output
+ generate-error-output
+ bindings-as-html
+ extract-bindings
+ extract-binding/single
+ get-cgi-method
+
+ ;; -- general HTML utilities --
+ string->html
+ generate-link-text)
+
+;; type bindings = list ((symbol . string))
+
+;; --------------------------------------------------------------------
+
+;; Exceptions:
+
+(define-struct cgi-error ())
+
+;; chars : list (char)
+;; -- gives the suffix which is invalid, not including the `%'
+
+(define-struct (incomplete-%-suffix cgi-error) (chars))
+
+;; char : char
+;; -- an invalid character in a hex string
+
+(define-struct (invalid-%-suffix cgi-error) (char))
+
+;; --------------------------------------------------------------------
+
+;; query-string->string : string -> string
+
+;; -- The input is the string post-processed as per Web specs, which
+;; is as follows:
+;; spaces are turned into "+"es and lots of things are turned into %XX, where
+;; XX are hex digits, eg, %E7 for ~.  The output is a regular Scheme string
+;; with all the characters converted back.
+
+(define query-string->string form-urlencoded-decode)
+
+;; string->html : string -> string
+;; -- the input is raw text, the output is HTML appropriately quoted
+
+(define (string->html s)
+  (apply string-append
+         (map (lambda (c)
+                (case c
+                  [(#\<) "&lt;"]
+                  [(#\>) "&gt;"]
+                  [(#\&) "&amp;"]
+                  [else (string c)]))
+              (string->list s))))
+
+(define default-text-color  "#000000")
+(define default-bg-color    "#ffffff")
+(define default-link-color  "#cc2200")
+(define default-vlink-color "#882200")
+(define default-alink-color "#444444")
+
+;; generate-html-output :
+;; html-string x list (html-string) x ... -> ()
+
+(define (generate-html-output title body-lines
+                              [text-color default-text-color]
+                              [bg-color default-bg-color]
+                              [link-color default-link-color]
+                              [vlink-color default-vlink-color]
+                              [alink-color default-alink-color])
+  (let ([sa string-append])
+    (for ([l `("Content-type: text/html"
+               ""
+               "<html>"
+               "<!-- The form was processed, and this document was generated,"
+               "     using the CGI utilities for Racket.  For more information"
+               "     on Racket, see"
+               "       http://racket-lang.org/"
+               "     and for the CGI utilities, contact"
+               "     (sk@cs.brown.edu). -->"
+               "<head>"
+               ,(sa "<title>" title "</title>")
+               "</head>"
+               ""
+               ,(sa "<body bgcolor=\"" bg-color "\" text=\"" text-color "\"")
+               ,(sa "      link=\"" link-color "\"")
+               ,(sa "      vlink=\"" vlink-color "\" alink=\"" alink-color "\">")
+               ""
+               ,@body-lines
+               ""
+               "</body>"
+               "</html>")])
+      (display l)
+      (newline))))
+
+;; output-http-headers : -> void
+(define (output-http-headers)
+  (printf "Content-type: text/html\r\n\r\n"))
+
+;; delimiter->predicate : symbol -> regexp
+;; returns a regexp to read a chunk of text up to a delimiter (excluding it)
+(define (delimiter->rx delimiter)
+  (case delimiter
+    [(amp)         #rx#"^[^&]*"]
+    [(semi)        #rx#"^[^;]*"]
+    [(amp-or-semi) #rx#"^[^&;]*"]
+    [else (error 'delimiter->rx
+                 "internal-error, unknown delimiter: ~e" delimiter)]))
+
+;; get-bindings* : iport -> (listof (cons symbol string))
+;; Reads all bindings from the input port.  The strings are processed to
+;; remove the CGI spec "escape"s.
+;; This code is _slightly_ lax: it allows an input to end in
+;; (current-alist-separator-mode).  It's not clear this is legal by the
+;; CGI spec, which suggests that the last value binding must end in an
+;; EOF.  It doesn't look like this matters.
+;; ELI: * Keeping this behavior for now, maybe better to remove it?
+;;      * Looks like `form-urlencoded->alist' is doing almost exactly
+;;        the same job this code does.
+(define (get-bindings* method ip)
+  (define (err fmt . xs)
+    (generate-error-output
+     (list (format "Server generated malformed input for ~a method:" method)
+           (apply format fmt xs))))
+  (define value-rx (delimiter->rx (current-alist-separator-mode)))
+  (define (process str) (query-string->string (bytes->string/utf-8 str)))
+  (let loop ([bindings '()])
+    (if (eof-object? (peek-char ip))
+      (reverse bindings)
+      (let ()
+        (define name (car (or (regexp-match #rx"^[^=]+" ip)
+                              (err "Missing field name before `='"))))
+        (unless (eq? #\= (read-char ip))
+          (err "No binding for `~a' field." name))
+        (define value (car (regexp-match value-rx ip)))
+        (read-char ip) ; consume the delimiter, possibly eof (retested above)
+        (loop (cons (cons (string->symbol (process name)) (process value))
+                    bindings))))))
+
+;; get-bindings/post : () -> bindings
+(define (get-bindings/post)
+  (get-bindings* "POST" (current-input-port)))
+
+;; get-bindings/get : () -> bindings
+(define (get-bindings/get)
+  (get-bindings* "GET" (open-input-string (getenv "QUERY_STRING"))))
+
+;; get-bindings : () -> bindings
+(define (get-bindings)
+  (if (string=? (get-cgi-method) "POST")
+    (get-bindings/post)
+    (get-bindings/get)))
+
+;; generate-error-output : list (html-string) -> <exit>
+(define (generate-error-output error-message-lines)
+  (generate-html-output "Internal Error" error-message-lines)
+  (exit))
+
+;; bindings-as-html : bindings -> list (html-string)
+;; -- formats name-value bindings as HTML appropriate for displaying
+(define (bindings-as-html bindings)
+  `("<code>"
+    ,@(map (lambda (bind)
+             (string-append (symbol->string (car bind))
+                            "&nbsp;--&gt;&nbsp;"
+                            (cdr bind)
+                            "<br>"))
+           bindings)
+    "</code>"))
+
+;; extract-bindings : (string + symbol) x bindings -> list (string)
+;; -- Extracts the bindings associated with a given name.  The semantics of
+;; forms states that a CHECKBOX may use the same NAME field multiple times.
+;; Hence, a list of strings is returned.  Note that the result may be the
+;; empty list.
+(define (extract-bindings field-name bindings)
+  (let ([field-name (if (symbol? field-name)
+                      field-name (string->symbol field-name))])
+    (let loop ([found null] [bindings bindings])
+      (if (null? bindings)
+        found
+        (if (equal? field-name (caar bindings))
+          (loop (cons (cdar bindings) found) (cdr bindings))
+          (loop found (cdr bindings)))))))
+
+;; extract-binding/single : (string + symbol) x bindings -> string
+;; -- used in cases where only one binding is supposed to occur
+(define (extract-binding/single field-name bindings)
+  (let* ([field-name (if (symbol? field-name)
+                       field-name (string->symbol field-name))]
+         [result (extract-bindings field-name bindings)])
+    (cond
+      [(null? result)
+       (generate-error-output
+        (cons (format "No binding for field `~a':<br>" field-name)
+              (bindings-as-html bindings)))]
+      [(null? (cdr result))
+       (car result)]
+      [else
+       (generate-error-output
+        (cons (format "Multiple bindings for field `~a' where one expected:<br>"
+                      field-name)
+              (bindings-as-html bindings)))])))
+
+;; get-cgi-method : () -> string
+;; -- string is either GET or POST (though future extension is possible)
+(define (get-cgi-method)
+  (or (getenv "REQUEST_METHOD")
+      (error 'get-cgi-method "no REQUEST_METHOD environment variable")))
+
+;; generate-link-text : string x html-string -> html-string
+(define (generate-link-text url anchor-text)
+  (string-append "<a href=\"" url "\">" anchor-text "</a>"))
diff --git a/collects/net/dns-unit.rkt b/collects/net/dns-unit.rkt
index 9c0d175963..f5f99fb94b 100644
--- a/collects/net/dns-unit.rkt
+++ b/collects/net/dns-unit.rkt
@@ -1,338 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require "dns-sig.rkt" racket/system racket/udp)
+(require racket/unit
+         "dns-sig.rkt" "dns.rkt")
 
-(import)
-(export dns^)
+(define-unit-from-context dns@ dns^)
 
-;; UDP retry timeout:
-(define INIT-TIMEOUT 50)
-
-(define types
-  '((a 1)
-    (ns 2)
-    (md 3)
-    (mf 4)
-    (cname 5)
-    (soa 6)
-    (mb 7)
-    (mg 8)
-    (mr 9)
-    (null 10)
-    (wks 11)
-    (ptr 12)
-    (hinfo 13)
-    (minfo 14)
-    (mx 15)
-    (txt 16)))
-
-(define classes
-  '((in 1)
-    (cs 2)
-    (ch 3)
-    (hs 4)))
-
-(define (cossa i l)
-  (cond [(null? l) #f]
-        [(equal? (cadar l) i) (car l)]
-        [else (cossa i (cdr l))]))
-
-(define (number->octet-pair n)
-  (list (arithmetic-shift n -8)
-        (modulo n 256)))
-
-(define (octet-pair->number a b)
-  (+ (arithmetic-shift a 8) b))
-
-(define (octet-quad->number a b c d)
-  (+ (arithmetic-shift a 24)
-     (arithmetic-shift b 16)
-     (arithmetic-shift c 8)
-     d))
-
-(define (name->octets s)
-  (let ([do-one (lambda (s) (cons (bytes-length s) (bytes->list s)))])
-    (let loop ([s s])
-      (let ([m (regexp-match #rx#"^([^.]*)[.](.*)" s)])
-        (if m
-          (append (do-one (cadr m)) (loop (caddr m)))
-          (append (do-one s) (list 0)))))))
-
-(define (make-std-query-header id question-count)
-  (append (number->octet-pair id)
-          (list 1 0) ; Opcode & flags (recusive flag set)
-          (number->octet-pair question-count)
-          (number->octet-pair 0)
-          (number->octet-pair 0)
-          (number->octet-pair 0)))
-
-(define (make-query id name type class)
-  (append (make-std-query-header id 1)
-          (name->octets name)
-          (number->octet-pair (cadr (assoc type types)))
-          (number->octet-pair (cadr (assoc class classes)))))
-
-(define (add-size-tag m)
-  (append (number->octet-pair (length m)) m))
-
-(define (rr-data rr)
-  (cadddr (cdr rr)))
-
-(define (rr-type rr)
-  (cadr rr))
-
-(define (rr-name rr)
-  (car rr))
-
-(define (parse-name start reply)
-  (let ([v (car start)])
-    (cond
-      [(zero? v)
-       ;; End of name
-       (values #f (cdr start))]
-      [(zero? (bitwise-and #xc0 v))
-       ;; Normal label
-       (let loop ([len v][start (cdr start)][accum null])
-         (if (zero? len)
-           (let-values ([(s start) (parse-name start reply)])
-             (let ([s0 (list->bytes (reverse accum))])
-               (values (if s (bytes-append s0 #"." s) s0)
-                       start)))
-           (loop (sub1 len) (cdr start) (cons (car start) accum))))]
-      [else
-       ;; Compression offset
-       (let ([offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
-                        (cadr start))])
-         (let-values ([(s ignore-start)
-                       (parse-name (list-tail reply offset) reply)])
-           (values s (cddr start))))])))
-
-(define (parse-rr start reply)
-  (let-values ([(name start) (parse-name start reply)])
-    (let* ([type (car (cossa (octet-pair->number (car start) (cadr start))
-                             types))]
-           [start (cddr start)]
-           ;;
-           [class (car (cossa (octet-pair->number (car start) (cadr start))
-                              classes))]
-           [start (cddr start)]
-           ;;
-           [ttl (octet-quad->number (car start) (cadr start)
-                                    (caddr start) (cadddr start))]
-           [start (cddddr start)]
-           ;;
-           [len (octet-pair->number (car start) (cadr start))]
-           [start (cddr start)])
-      ;; Extract next len bytes for data:
-      (let loop ([len len] [start start] [accum null])
-        (if (zero? len)
-          (values (list name type class ttl (reverse accum))
-                  start)
-          (loop (sub1 len) (cdr start) (cons (car start) accum)))))))
-
-(define (parse-ques start reply)
-  (let-values ([(name start) (parse-name start reply)])
-    (let* ([type (car (cossa (octet-pair->number (car start) (cadr start))
-                             types))]
-           [start (cddr start)]
-           ;;
-           [class (car (cossa (octet-pair->number (car start) (cadr start))
-                              classes))]
-           [start (cddr start)])
-      (values (list name type class) start))))
-
-(define (parse-n parse start reply n)
-  (let loop ([n n][start start][accum null])
-    (if (zero? n)
-      (values (reverse accum) start)
-      (let-values ([(rr start) (parse start reply)])
-        (loop (sub1 n) start (cons rr accum))))))
-
-(define (dns-query nameserver addr type class)
-  (unless (assoc type types)
-    (raise-type-error 'dns-query "DNS query type" type))
-  (unless (assoc class classes)
-    (raise-type-error 'dns-query "DNS query class" class))
-
-  (let* ([query (make-query (random 256) (string->bytes/latin-1 addr)
-                            type class)]
-         [udp (udp-open-socket)]
-         [reply
-          (dynamic-wind
-            void
-            (lambda ()
-              (let ([s (make-bytes 512)])
-                (let retry ([timeout INIT-TIMEOUT])
-                  (udp-send-to udp nameserver 53 (list->bytes query))
-                  (sync (handle-evt (udp-receive!-evt udp s)
-                                    (lambda (r)
-                                      (bytes->list (subbytes s 0 (car r)))))
-                        (handle-evt (alarm-evt (+ (current-inexact-milliseconds)
-                                                  timeout))
-                                    (lambda (v)
-                                      (retry (* timeout 2))))))))
-            (lambda () (udp-close udp)))])
-
-    ;; First two bytes must match sent message id:
-    (unless (and (= (car reply) (car query))
-                 (= (cadr reply) (cadr query)))
-      (error 'dns-query "bad reply id from server"))
-
-    (let ([v0 (caddr reply)]
-          [v1 (cadddr reply)])
-      ;; Check for error code:
-      (let ([rcode (bitwise-and #xf v1)])
-        (unless (zero? rcode)
-          (error 'dns-query "error from server: ~a"
-                 (case rcode
-                   [(1) "format error"]
-                   [(2) "server failure"]
-                   [(3) "name error"]
-                   [(4) "not implemented"]
-                   [(5) "refused"]))))
-
-      (let ([qd-count (octet-pair->number (list-ref reply 4) (list-ref reply 5))]
-            [an-count (octet-pair->number (list-ref reply 6) (list-ref reply 7))]
-            [ns-count (octet-pair->number (list-ref reply 8) (list-ref reply 9))]
-            [ar-count (octet-pair->number (list-ref reply 10) (list-ref reply 11))])
-
-        (let ([start (list-tail reply 12)])
-          (let*-values ([(qds start) (parse-n parse-ques start reply qd-count)]
-                        [(ans start) (parse-n parse-rr start reply an-count)]
-                        [(nss start) (parse-n parse-rr start reply ns-count)]
-                        [(ars start) (parse-n parse-rr start reply ar-count)])
-            (unless (null? start)
-              (error 'dns-query "error parsing server reply"))
-            (values (positive? (bitwise-and #x4 v0))
-                    qds ans nss ars reply)))))))
-
-(define cache (make-hasheq))
-(define (dns-query/cache nameserver addr type class)
-  (let ([key (string->symbol (format "~a;~a;~a;~a" nameserver addr type class))])
-    (let ([v (hash-ref cache key (lambda () #f))])
-      (if v
-        (apply values v)
-        (let-values ([(auth? qds ans nss ars reply)
-                      (dns-query nameserver addr type class)])
-          (hash-set! cache key (list auth? qds ans nss ars reply))
-          (values auth? qds ans nss ars reply))))))
-
-(define (ip->string s)
-  (format "~a.~a.~a.~a"
-          (list-ref s 0) (list-ref s 1) (list-ref s 2) (list-ref s 3)))
-
-(define (try-forwarding k nameserver)
-  (let loop ([nameserver nameserver][tried (list nameserver)])
-    ;; Normally the recusion is done for us, but it's technically optional
-    (let-values ([(v ars auth?) (k nameserver)])
-      (or v
-          (and (not auth?)
-               (let* ([ns (ormap (lambda (ar)
-                                   (and (eq? (rr-type ar) 'a)
-                                        (ip->string (rr-data ar))))
-                                 ars)])
-                 (and ns
-                      (not (member ns tried))
-                      (loop ns (cons ns tried)))))))))
-
-(define (ip->in-addr.arpa ip)
-  (let ([result (regexp-match #rx"^([0-9]+)\\.([0-9]+)\\.([0-9]+)\\.([0-9]+)$"
-                              ip)])
-    (format "~a.~a.~a.~a.in-addr.arpa"
-            (list-ref result 4)
-            (list-ref result 3)
-            (list-ref result 2)
-            (list-ref result 1))))
-
-(define (get-ptr-list-from-ans ans)
-  (filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'ptr)) ans))
-
-(define (dns-get-name nameserver ip)
-  (or (try-forwarding
-       (lambda (nameserver)
-         (let-values ([(auth? qds ans nss ars reply)
-                       (dns-query/cache nameserver (ip->in-addr.arpa ip) 'ptr 'in)])
-           (values (and (positive? (length (get-ptr-list-from-ans ans)))
-                        (let ([s (rr-data (car (get-ptr-list-from-ans ans)))])
-                          (let-values ([(name null) (parse-name s reply)])
-                            (bytes->string/latin-1 name))))
-                   ars auth?)))
-       nameserver)
-      (error 'dns-get-name "bad ip address")))
-
-(define (get-a-list-from-ans ans)
-  (filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'a))
-          ans))
-
-(define (dns-get-address nameserver addr)
-  (or (try-forwarding
-       (lambda (nameserver)
-         (let-values ([(auth? qds ans nss ars reply) (dns-query/cache nameserver addr 'a 'in)])
-           (values (and (positive? (length (get-a-list-from-ans ans)))
-                        (let ([s (rr-data (car (get-a-list-from-ans ans)))])
-                          (ip->string s)))
-                   ars auth?)))
-       nameserver)
-      (error 'dns-get-address "bad address")))
-
-(define (dns-get-mail-exchanger nameserver addr)
-  (or (try-forwarding
-       (lambda (nameserver)
-         (let-values ([(auth? qds ans nss ars reply) (dns-query/cache nameserver addr 'mx 'in)])
-           (values (let loop ([ans ans][best-pref +inf.0][exchanger #f])
-                     (cond
-                       [(null? ans)
-                        (or exchanger
-                            ;; Does 'soa mean that the input address is fine?
-                            (and (ormap (lambda (ns) (eq? (rr-type ns) 'soa))
-                                        nss)
-                                 addr))]
-                       [else
-                        (let ([d (rr-data (car ans))])
-                          (let ([pref (octet-pair->number (car d) (cadr d))])
-                            (if (< pref best-pref)
-                              (let-values ([(name start) (parse-name (cddr d) reply)])
-                                (loop (cdr ans) pref name))
-                              (loop (cdr ans) best-pref exchanger))))]))
-                   ars auth?)))
-       nameserver)
-      (error 'dns-get-mail-exchanger "bad address")))
-
-(define (dns-find-nameserver)
-  (case (system-type)
-    [(unix macosx)
-     (with-handlers ([void (lambda (x) #f)])
-       (with-input-from-file "/etc/resolv.conf"
-         (lambda ()
-           (let loop ()
-             (let ([l (read-line)])
-               (or (and (string? l)
-                        (let ([m (regexp-match
-                                  #rx"nameserver[ \t]+([0-9]+[.][0-9]+[.][0-9]+[.][0-9]+)"
-                                  l)])
-                          (and m (cadr m))))
-                   (and (not (eof-object? l))
-                        (loop))))))))]
-    [(windows)
-     (let ([nslookup (find-executable-path "nslookup.exe" #f)])
-       (and nslookup
-            (let-values ([(pin pout pid perr proc)
-                          (apply
-                           values
-                           (process/ports
-                            #f (open-input-file "NUL") (current-error-port)
-                            nslookup))])
-              (let loop ([name #f] [ip #f] [try-ip? #f])
-                (let ([line (read-line pin 'any)])
-                  (cond [(eof-object? line)
-                         (close-input-port pin)
-                         (proc 'wait)
-                         (or ip name)]
-                        [(and (not name)
-                              (regexp-match #rx"^Default Server: +(.*)$" line))
-                         => (lambda (m) (loop (cadr m) #f #t))]
-                        [(and try-ip?
-                              (regexp-match #rx"^Address: +(.*)$" line))
-                         => (lambda (m) (loop name (cadr m) #f))]
-                        [else (loop name ip #f)]))))))]
-    [else #f]))
+(provide dns@)
diff --git a/collects/net/dns.rkt b/collects/net/dns.rkt
index 901649091f..6496204bb7 100644
--- a/collects/net/dns.rkt
+++ b/collects/net/dns.rkt
@@ -1,6 +1,341 @@
 #lang racket/base
-(require racket/unit "dns-sig.rkt" "dns-unit.rkt")
 
-(define-values/invoke-unit/infer dns@)
+(require racket/udp
+         racket/system)
 
-(provide-signature-elements dns^)
+(provide dns-get-address
+         dns-get-name
+         dns-get-mail-exchanger
+         dns-find-nameserver)
+
+;; UDP retry timeout:
+(define INIT-TIMEOUT 50)
+
+(define types
+  '((a 1)
+    (ns 2)
+    (md 3)
+    (mf 4)
+    (cname 5)
+    (soa 6)
+    (mb 7)
+    (mg 8)
+    (mr 9)
+    (null 10)
+    (wks 11)
+    (ptr 12)
+    (hinfo 13)
+    (minfo 14)
+    (mx 15)
+    (txt 16)))
+
+(define classes
+  '((in 1)
+    (cs 2)
+    (ch 3)
+    (hs 4)))
+
+(define (cossa i l)
+  (cond [(null? l) #f]
+        [(equal? (cadar l) i) (car l)]
+        [else (cossa i (cdr l))]))
+
+(define (number->octet-pair n)
+  (list (arithmetic-shift n -8)
+        (modulo n 256)))
+
+(define (octet-pair->number a b)
+  (+ (arithmetic-shift a 8) b))
+
+(define (octet-quad->number a b c d)
+  (+ (arithmetic-shift a 24)
+     (arithmetic-shift b 16)
+     (arithmetic-shift c 8)
+     d))
+
+(define (name->octets s)
+  (let ([do-one (lambda (s) (cons (bytes-length s) (bytes->list s)))])
+    (let loop ([s s])
+      (let ([m (regexp-match #rx#"^([^.]*)[.](.*)" s)])
+        (if m
+          (append (do-one (cadr m)) (loop (caddr m)))
+          (append (do-one s) (list 0)))))))
+
+(define (make-std-query-header id question-count)
+  (append (number->octet-pair id)
+          (list 1 0) ; Opcode & flags (recusive flag set)
+          (number->octet-pair question-count)
+          (number->octet-pair 0)
+          (number->octet-pair 0)
+          (number->octet-pair 0)))
+
+(define (make-query id name type class)
+  (append (make-std-query-header id 1)
+          (name->octets name)
+          (number->octet-pair (cadr (assoc type types)))
+          (number->octet-pair (cadr (assoc class classes)))))
+
+(define (add-size-tag m)
+  (append (number->octet-pair (length m)) m))
+
+(define (rr-data rr)
+  (cadddr (cdr rr)))
+
+(define (rr-type rr)
+  (cadr rr))
+
+(define (rr-name rr)
+  (car rr))
+
+(define (parse-name start reply)
+  (let ([v (car start)])
+    (cond
+      [(zero? v)
+       ;; End of name
+       (values #f (cdr start))]
+      [(zero? (bitwise-and #xc0 v))
+       ;; Normal label
+       (let loop ([len v][start (cdr start)][accum null])
+         (if (zero? len)
+           (let-values ([(s start) (parse-name start reply)])
+             (let ([s0 (list->bytes (reverse accum))])
+               (values (if s (bytes-append s0 #"." s) s0)
+                       start)))
+           (loop (sub1 len) (cdr start) (cons (car start) accum))))]
+      [else
+       ;; Compression offset
+       (let ([offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
+                        (cadr start))])
+         (let-values ([(s ignore-start)
+                       (parse-name (list-tail reply offset) reply)])
+           (values s (cddr start))))])))
+
+(define (parse-rr start reply)
+  (let-values ([(name start) (parse-name start reply)])
+    (let* ([type (car (cossa (octet-pair->number (car start) (cadr start))
+                             types))]
+           [start (cddr start)]
+           ;;
+           [class (car (cossa (octet-pair->number (car start) (cadr start))
+                              classes))]
+           [start (cddr start)]
+           ;;
+           [ttl (octet-quad->number (car start) (cadr start)
+                                    (caddr start) (cadddr start))]
+           [start (cddddr start)]
+           ;;
+           [len (octet-pair->number (car start) (cadr start))]
+           [start (cddr start)])
+      ;; Extract next len bytes for data:
+      (let loop ([len len] [start start] [accum null])
+        (if (zero? len)
+          (values (list name type class ttl (reverse accum))
+                  start)
+          (loop (sub1 len) (cdr start) (cons (car start) accum)))))))
+
+(define (parse-ques start reply)
+  (let-values ([(name start) (parse-name start reply)])
+    (let* ([type (car (cossa (octet-pair->number (car start) (cadr start))
+                             types))]
+           [start (cddr start)]
+           ;;
+           [class (car (cossa (octet-pair->number (car start) (cadr start))
+                              classes))]
+           [start (cddr start)])
+      (values (list name type class) start))))
+
+(define (parse-n parse start reply n)
+  (let loop ([n n][start start][accum null])
+    (if (zero? n)
+      (values (reverse accum) start)
+      (let-values ([(rr start) (parse start reply)])
+        (loop (sub1 n) start (cons rr accum))))))
+
+(define (dns-query nameserver addr type class)
+  (unless (assoc type types)
+    (raise-type-error 'dns-query "DNS query type" type))
+  (unless (assoc class classes)
+    (raise-type-error 'dns-query "DNS query class" class))
+
+  (let* ([query (make-query (random 256) (string->bytes/latin-1 addr)
+                            type class)]
+         [udp (udp-open-socket)]
+         [reply
+          (dynamic-wind
+            void
+            (lambda ()
+              (let ([s (make-bytes 512)])
+                (let retry ([timeout INIT-TIMEOUT])
+                  (udp-send-to udp nameserver 53 (list->bytes query))
+                  (sync (handle-evt (udp-receive!-evt udp s)
+                                    (lambda (r)
+                                      (bytes->list (subbytes s 0 (car r)))))
+                        (handle-evt (alarm-evt (+ (current-inexact-milliseconds)
+                                                  timeout))
+                                    (lambda (v)
+                                      (retry (* timeout 2))))))))
+            (lambda () (udp-close udp)))])
+
+    ;; First two bytes must match sent message id:
+    (unless (and (= (car reply) (car query))
+                 (= (cadr reply) (cadr query)))
+      (error 'dns-query "bad reply id from server"))
+
+    (let ([v0 (caddr reply)]
+          [v1 (cadddr reply)])
+      ;; Check for error code:
+      (let ([rcode (bitwise-and #xf v1)])
+        (unless (zero? rcode)
+          (error 'dns-query "error from server: ~a"
+                 (case rcode
+                   [(1) "format error"]
+                   [(2) "server failure"]
+                   [(3) "name error"]
+                   [(4) "not implemented"]
+                   [(5) "refused"]))))
+
+      (let ([qd-count (octet-pair->number (list-ref reply 4) (list-ref reply 5))]
+            [an-count (octet-pair->number (list-ref reply 6) (list-ref reply 7))]
+            [ns-count (octet-pair->number (list-ref reply 8) (list-ref reply 9))]
+            [ar-count (octet-pair->number (list-ref reply 10) (list-ref reply 11))])
+
+        (let ([start (list-tail reply 12)])
+          (let*-values ([(qds start) (parse-n parse-ques start reply qd-count)]
+                        [(ans start) (parse-n parse-rr start reply an-count)]
+                        [(nss start) (parse-n parse-rr start reply ns-count)]
+                        [(ars start) (parse-n parse-rr start reply ar-count)])
+            (unless (null? start)
+              (error 'dns-query "error parsing server reply"))
+            (values (positive? (bitwise-and #x4 v0))
+                    qds ans nss ars reply)))))))
+
+(define cache (make-hasheq))
+(define (dns-query/cache nameserver addr type class)
+  (let ([key (string->symbol (format "~a;~a;~a;~a" nameserver addr type class))])
+    (let ([v (hash-ref cache key (lambda () #f))])
+      (if v
+        (apply values v)
+        (let-values ([(auth? qds ans nss ars reply)
+                      (dns-query nameserver addr type class)])
+          (hash-set! cache key (list auth? qds ans nss ars reply))
+          (values auth? qds ans nss ars reply))))))
+
+(define (ip->string s)
+  (format "~a.~a.~a.~a"
+          (list-ref s 0) (list-ref s 1) (list-ref s 2) (list-ref s 3)))
+
+(define (try-forwarding k nameserver)
+  (let loop ([nameserver nameserver][tried (list nameserver)])
+    ;; Normally the recusion is done for us, but it's technically optional
+    (let-values ([(v ars auth?) (k nameserver)])
+      (or v
+          (and (not auth?)
+               (let* ([ns (ormap (lambda (ar)
+                                   (and (eq? (rr-type ar) 'a)
+                                        (ip->string (rr-data ar))))
+                                 ars)])
+                 (and ns
+                      (not (member ns tried))
+                      (loop ns (cons ns tried)))))))))
+
+(define (ip->in-addr.arpa ip)
+  (let ([result (regexp-match #rx"^([0-9]+)\\.([0-9]+)\\.([0-9]+)\\.([0-9]+)$"
+                              ip)])
+    (format "~a.~a.~a.~a.in-addr.arpa"
+            (list-ref result 4)
+            (list-ref result 3)
+            (list-ref result 2)
+            (list-ref result 1))))
+
+(define (get-ptr-list-from-ans ans)
+  (filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'ptr)) ans))
+
+(define (dns-get-name nameserver ip)
+  (or (try-forwarding
+       (lambda (nameserver)
+         (let-values ([(auth? qds ans nss ars reply)
+                       (dns-query/cache nameserver (ip->in-addr.arpa ip) 'ptr 'in)])
+           (values (and (positive? (length (get-ptr-list-from-ans ans)))
+                        (let ([s (rr-data (car (get-ptr-list-from-ans ans)))])
+                          (let-values ([(name null) (parse-name s reply)])
+                            (bytes->string/latin-1 name))))
+                   ars auth?)))
+       nameserver)
+      (error 'dns-get-name "bad ip address")))
+
+(define (get-a-list-from-ans ans)
+  (filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'a))
+          ans))
+
+(define (dns-get-address nameserver addr)
+  (or (try-forwarding
+       (lambda (nameserver)
+         (let-values ([(auth? qds ans nss ars reply) (dns-query/cache nameserver addr 'a 'in)])
+           (values (and (positive? (length (get-a-list-from-ans ans)))
+                        (let ([s (rr-data (car (get-a-list-from-ans ans)))])
+                          (ip->string s)))
+                   ars auth?)))
+       nameserver)
+      (error 'dns-get-address "bad address")))
+
+(define (dns-get-mail-exchanger nameserver addr)
+  (or (try-forwarding
+       (lambda (nameserver)
+         (let-values ([(auth? qds ans nss ars reply) (dns-query/cache nameserver addr 'mx 'in)])
+           (values (let loop ([ans ans][best-pref +inf.0][exchanger #f])
+                     (cond
+                       [(null? ans)
+                        (or exchanger
+                            ;; Does 'soa mean that the input address is fine?
+                            (and (ormap (lambda (ns) (eq? (rr-type ns) 'soa))
+                                        nss)
+                                 addr))]
+                       [else
+                        (let ([d (rr-data (car ans))])
+                          (let ([pref (octet-pair->number (car d) (cadr d))])
+                            (if (< pref best-pref)
+                              (let-values ([(name start) (parse-name (cddr d) reply)])
+                                (loop (cdr ans) pref name))
+                              (loop (cdr ans) best-pref exchanger))))]))
+                   ars auth?)))
+       nameserver)
+      (error 'dns-get-mail-exchanger "bad address")))
+
+(define (dns-find-nameserver)
+  (case (system-type)
+    [(unix macosx)
+     (with-handlers ([void (lambda (x) #f)])
+       (with-input-from-file "/etc/resolv.conf"
+         (lambda ()
+           (let loop ()
+             (let ([l (read-line)])
+               (or (and (string? l)
+                        (let ([m (regexp-match
+                                  #rx"nameserver[ \t]+([0-9]+[.][0-9]+[.][0-9]+[.][0-9]+)"
+                                  l)])
+                          (and m (cadr m))))
+                   (and (not (eof-object? l))
+                        (loop))))))))]
+    [(windows)
+     (let ([nslookup (find-executable-path "nslookup.exe" #f)])
+       (and nslookup
+            (let-values ([(pin pout pid perr proc)
+                          (apply
+                           values
+                           (process/ports
+                            #f (open-input-file "NUL") (current-error-port)
+                            nslookup))])
+              (let loop ([name #f] [ip #f] [try-ip? #f])
+                (let ([line (read-line pin 'any)])
+                  (cond [(eof-object? line)
+                         (close-input-port pin)
+                         (proc 'wait)
+                         (or ip name)]
+                        [(and (not name)
+                              (regexp-match #rx"^Default Server: +(.*)$" line))
+                         => (lambda (m) (loop (cadr m) #f #t))]
+                        [(and try-ip?
+                              (regexp-match #rx"^Address: +(.*)$" line))
+                         => (lambda (m) (loop name (cadr m) #f))]
+                        [else (loop name ip #f)]))))))]
+    [else #f]))
diff --git a/collects/net/ftp-unit.rkt b/collects/net/ftp-unit.rkt
index 77436f8f4d..42432a561f 100644
--- a/collects/net/ftp-unit.rkt
+++ b/collects/net/ftp-unit.rkt
@@ -1,213 +1,12 @@
-#lang racket/unit
+#lang racket/base
 
 ;; Version 0.2
 ;;   Version 0.1a
 ;;   Micah Flatt
 ;;   06-06-2002
-(require racket/date racket/file racket/port racket/tcp "ftp-sig.rkt")
-(import)
-(export ftp^)
+(require racket/unit
+         "ftp-sig.rkt" "ftp.rkt")
 
-;; opqaue record to represent an FTP connection:
-(define-struct ftp-connection (in out))
+(define-unit-from-context ftp@ ftp^)
 
-(define re:multi-response-start #rx#"^[0-9][0-9][0-9]-")
-(define re:response-end #rx#"^[0-9][0-9][0-9] ")
-
-(define (check-expected-result line expected)
-  (when expected
-    (unless (ormap (lambda (expected)
-                     (bytes=? expected (subbytes line 0 3)))
-                   (if (bytes? expected)
-                       (list expected)
-                       expected))
-      (error 'ftp "expected result code ~a, got ~a" expected line))))
-
-;; ftp-check-response : input-port output-port bytes-or-byteslist-or-#f (bytes any -> any) any -> any
-;;
-;;  Checks a standard-format response, checking for the given
-;;  expected 3-digit result code if expected is not #f.
-;;
-;;  While checking, the function sends response lines to
-;;  diagnostic-accum. This function -accum functions can return a
-;;  value that accumulates over multiple calls to the function, and
-;;  accum-start is used as the initial value. Use `void' and
-;;  `(void)' to ignore the response info.
-;;
-;; If an unexpected result is found, an exception is raised, and the
-;; stream is left in an undefined state.
-(define (ftp-check-response tcpin tcpout expected diagnostic-accum accum-start)
-  (flush-output tcpout)
-  (let ([line (read-bytes-line tcpin 'any)])
-    (cond
-     [(eof-object? line)
-      (error 'ftp "unexpected EOF")]
-     [(regexp-match re:multi-response-start line)
-      (check-expected-result line expected)
-      (let ([re:done (regexp (format "^~a " (subbytes line 0 3)))])
-        (let loop ([accum (diagnostic-accum line accum-start)])
-          (let ([line (read-bytes-line tcpin 'any)])
-            (cond [(eof-object? line)
-                   (error 'ftp "unexpected EOF")]
-                  [(regexp-match re:done line)
-                   (diagnostic-accum line accum)]
-                  [else
-                   (loop (diagnostic-accum line accum))]))))]
-     [(regexp-match re:response-end line)
-      (check-expected-result line expected)
-      (diagnostic-accum line accum-start)]
-     [else
-      (error 'ftp "unexpected result: ~e" line)])))
-
-(define (get-month month-bytes)
-  (cond [(assoc month-bytes
-                '((#"Jan" 1) (#"Feb" 2) (#"Mar" 3) (#"Apr" 4) (#"May" 5)
-                  (#"Jun" 6) (#"Jul" 7) (#"Aug" 8) (#"Sep" 9) (#"Oct" 10)
-                  (#"Nov" 11) (#"Dec" 12)))
-         => cadr]
-        [else (error 'get-month "bad month: ~s" month-bytes)]))
-
-(define (bytes->number bytes)
-  (string->number (bytes->string/latin-1 bytes)))
-
-(define re:date #rx#"(...) *(.*) (..):(..)|(...) *([0-9]*) +(....)")
-
-(define (ftp-make-file-seconds ftp-date-str)
-  (define date-list (regexp-match re:date (string->bytes/utf-8 ftp-date-str)))
-  (if (not (list-ref date-list 4))
-      (find-seconds 0 0 0
-                    (bytes->number (list-ref date-list 6))
-                    (get-month (list-ref date-list 5))
-                    (bytes->number (list-ref date-list 7)))
-      (let* ([cur-secs (current-seconds)]
-             [cur-date (seconds->date cur-secs)]
-             [cur-year (date-year cur-date)]
-             [tzofs    (date-time-zone-offset cur-date)]
-             [minute (bytes->number (list-ref date-list 4))]
-             [hour   (bytes->number (list-ref date-list 3))]
-             [day    (bytes->number (list-ref date-list 2))]
-             [month  (get-month (list-ref date-list 1))]
-             [guess  (+ (find-seconds 0 minute hour day month cur-year) tzofs)])
-        (if (guess . <= . cur-secs)
-          guess
-          (+ (find-seconds 0 minute hour day month (sub1 cur-year)) tzofs)))))
-
-(define re:passive #rx#"\\((.*),(.*),(.*),(.*),(.*),(.*)\\)")
-
-(define (establish-data-connection tcp-ports)
-  (fprintf (ftp-connection-out tcp-ports) "PASV\r\n")
-  (let ([response (ftp-check-response
-                   (ftp-connection-in tcp-ports)
-                   (ftp-connection-out tcp-ports)
-                   #"227"
-                   (lambda (s ignore) s) ; should be the only response
-                   (void))])
-    (let* ([reg-list (regexp-match re:passive response)]
-           [pn1 (and reg-list
-                     (bytes->number (list-ref reg-list 5)))]
-           [pn2 (bytes->number (list-ref reg-list 6))])
-      (unless (and reg-list pn1 pn2)
-        (error 'ftp "can't understand PASV response: ~e" response))
-      (let-values ([(tcp-data tcp-data-out)
-                    (tcp-connect (format "~a.~a.~a.~a"
-                                         (list-ref reg-list 1)
-                                         (list-ref reg-list 2)
-                                         (list-ref reg-list 3)
-                                         (list-ref reg-list 4))
-                                 (+ (* 256 pn1) pn2))])
-        (fprintf (ftp-connection-out tcp-ports) "TYPE I\r\n")
-        (ftp-check-response (ftp-connection-in tcp-ports)
-                            (ftp-connection-out tcp-ports)
-                            #"200" void (void))
-        (tcp-abandon-port tcp-data-out)
-        tcp-data))))
-
-;; Used where version 0.1a printed responses:
-(define (print-msg s ignore)
-  ;; (printf "~a\n" s)
-  (void))
-
-(define (ftp-establish-connection* in out username password)
-  (ftp-check-response in out #"220" print-msg (void))
-  (fprintf out "USER ~a\r\n" username)
-  (let ([no-password? (ftp-check-response
-                       in out (list #"331" #"230")
-                       (lambda (line 230?)
-                         (or 230? (regexp-match #rx#"^230" line)))
-                       #f)])
-    (unless no-password?
-      (fprintf out "PASS ~a\r\n" password)
-      (ftp-check-response in out #"230" void (void))))
-  (make-ftp-connection in out))
-
-(define (ftp-establish-connection server-address server-port username password)
-  (let-values ([(tcpin tcpout) (tcp-connect server-address server-port)])
-    (ftp-establish-connection* tcpin tcpout username password)))
-
-(define (ftp-close-connection tcp-ports)
-  (fprintf (ftp-connection-out tcp-ports) "QUIT\r\n")
-  (ftp-check-response (ftp-connection-in tcp-ports)
-                      (ftp-connection-out tcp-ports)
-                      #"221" void (void))
-  (close-input-port (ftp-connection-in tcp-ports))
-  (close-output-port (ftp-connection-out tcp-ports)))
-
-(define (ftp-cd ftp-ports new-dir)
-  (fprintf (ftp-connection-out ftp-ports) "CWD ~a\r\n" new-dir)
-  (ftp-check-response (ftp-connection-in ftp-ports)
-                      (ftp-connection-out ftp-ports)
-                      #"250" void (void)))
-
-(define re:dir-line
-  (regexp (string-append
-           "^(.)(.*) ((?i:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)"
-           " .* [0-9][0-9]:?[0-9][0-9]) (.*)$")))
-
-(define (ftp-directory-list tcp-ports [path #f])
-  (define tcp-data (establish-data-connection tcp-ports))
-  (if path
-    (fprintf (ftp-connection-out tcp-ports) "LIST ~a\r\n" path)
-    (fprintf (ftp-connection-out tcp-ports) "LIST\r\n"))
-  (ftp-check-response (ftp-connection-in tcp-ports)
-                      (ftp-connection-out tcp-ports)
-                      (list #"150" #"125") void (void))
-  (define lines (port->lines tcp-data))
-  (close-input-port tcp-data)
-  (ftp-check-response (ftp-connection-in tcp-ports)
-                      (ftp-connection-out tcp-ports)
-                      #"226" print-msg (void))
-  (for*/list ([l (in-list lines)]
-              [m (in-value (cond [(regexp-match re:dir-line l) => cdr]
-                                 [else #f]))]
-              #:when m)
-    (define size (cond [(and (equal? "-" (car m))
-                             (regexp-match #rx"([0-9]+) *$" (cadr m)))
-                        => cadr]
-                       [else #f]))
-    (define r `(,(car m) ,@(cddr m)))
-    (if size `(,@r ,size) r)))
-
-(define (ftp-download-file tcp-ports folder filename)
-  ;; Save the file under the name tmp.file, rename it once download is
-  ;; complete this assures we don't over write any existing file without
-  ;; having a good file down
-  (let* ([tmpfile (make-temporary-file
-                   (string-append
-                    (regexp-replace
-                     #rx"~"
-                     (path->string (build-path folder "ftptmp"))
-                     "~~")
-                    "~a"))]
-         [new-file (open-output-file tmpfile #:exists 'replace)]
-         [tcp-data (establish-data-connection tcp-ports)])
-    (fprintf (ftp-connection-out tcp-ports) "RETR ~a\r\n" filename)
-    (ftp-check-response (ftp-connection-in tcp-ports)
-                        (ftp-connection-out tcp-ports)
-                        (list #"125" #"150") print-msg (void))
-    (copy-port tcp-data new-file)
-    (close-output-port new-file)
-    (close-input-port tcp-data)
-    (ftp-check-response (ftp-connection-in tcp-ports)
-                        (ftp-connection-out tcp-ports)
-                        #"226" print-msg (void))
-    (rename-file-or-directory tmpfile (build-path folder filename) #t)))
+(provide ftp@)
diff --git a/collects/net/ftp.rkt b/collects/net/ftp.rkt
index 5e4ff2a349..6702448612 100644
--- a/collects/net/ftp.rkt
+++ b/collects/net/ftp.rkt
@@ -1,6 +1,215 @@
 #lang racket/base
-(require racket/unit "ftp-sig.rkt" "ftp-unit.rkt")
 
-(define-values/invoke-unit/infer ftp@)
+(require racket/date racket/file racket/port racket/tcp)
 
-(provide-signature-elements ftp^)
+(provide ftp-connection?
+         ftp-cd
+         ftp-establish-connection ftp-establish-connection*
+         ftp-close-connection
+         ftp-directory-list
+         ftp-download-file
+         ftp-make-file-seconds)
+
+;; opqaue record to represent an FTP connection:
+(define-struct ftp-connection (in out))
+
+(define re:multi-response-start #rx#"^[0-9][0-9][0-9]-")
+(define re:response-end #rx#"^[0-9][0-9][0-9] ")
+
+(define (check-expected-result line expected)
+  (when expected
+    (unless (ormap (lambda (expected)
+                     (bytes=? expected (subbytes line 0 3)))
+                   (if (bytes? expected)
+                       (list expected)
+                       expected))
+      (error 'ftp "expected result code ~a, got ~a" expected line))))
+
+;; ftp-check-response : input-port output-port bytes-or-byteslist-or-#f (bytes any -> any) any -> any
+;;
+;;  Checks a standard-format response, checking for the given
+;;  expected 3-digit result code if expected is not #f.
+;;
+;;  While checking, the function sends response lines to
+;;  diagnostic-accum. This function -accum functions can return a
+;;  value that accumulates over multiple calls to the function, and
+;;  accum-start is used as the initial value. Use `void' and
+;;  `(void)' to ignore the response info.
+;;
+;; If an unexpected result is found, an exception is raised, and the
+;; stream is left in an undefined state.
+(define (ftp-check-response tcpin tcpout expected diagnostic-accum accum-start)
+  (flush-output tcpout)
+  (let ([line (read-bytes-line tcpin 'any)])
+    (cond
+     [(eof-object? line)
+      (error 'ftp "unexpected EOF")]
+     [(regexp-match re:multi-response-start line)
+      (check-expected-result line expected)
+      (let ([re:done (regexp (format "^~a " (subbytes line 0 3)))])
+        (let loop ([accum (diagnostic-accum line accum-start)])
+          (let ([line (read-bytes-line tcpin 'any)])
+            (cond [(eof-object? line)
+                   (error 'ftp "unexpected EOF")]
+                  [(regexp-match re:done line)
+                   (diagnostic-accum line accum)]
+                  [else
+                   (loop (diagnostic-accum line accum))]))))]
+     [(regexp-match re:response-end line)
+      (check-expected-result line expected)
+      (diagnostic-accum line accum-start)]
+     [else
+      (error 'ftp "unexpected result: ~e" line)])))
+
+(define (get-month month-bytes)
+  (cond [(assoc month-bytes
+                '((#"Jan" 1) (#"Feb" 2) (#"Mar" 3) (#"Apr" 4) (#"May" 5)
+                  (#"Jun" 6) (#"Jul" 7) (#"Aug" 8) (#"Sep" 9) (#"Oct" 10)
+                  (#"Nov" 11) (#"Dec" 12)))
+         => cadr]
+        [else (error 'get-month "bad month: ~s" month-bytes)]))
+
+(define (bytes->number bytes)
+  (string->number (bytes->string/latin-1 bytes)))
+
+(define re:date #rx#"(...) *(.*) (..):(..)|(...) *([0-9]*) +(....)")
+
+(define (ftp-make-file-seconds ftp-date-str)
+  (define date-list (regexp-match re:date (string->bytes/utf-8 ftp-date-str)))
+  (if (not (list-ref date-list 4))
+      (find-seconds 0 0 0
+                    (bytes->number (list-ref date-list 6))
+                    (get-month (list-ref date-list 5))
+                    (bytes->number (list-ref date-list 7)))
+      (let* ([cur-secs (current-seconds)]
+             [cur-date (seconds->date cur-secs)]
+             [cur-year (date-year cur-date)]
+             [tzofs    (date-time-zone-offset cur-date)]
+             [minute (bytes->number (list-ref date-list 4))]
+             [hour   (bytes->number (list-ref date-list 3))]
+             [day    (bytes->number (list-ref date-list 2))]
+             [month  (get-month (list-ref date-list 1))]
+             [guess  (+ (find-seconds 0 minute hour day month cur-year) tzofs)])
+        (if (guess . <= . cur-secs)
+          guess
+          (+ (find-seconds 0 minute hour day month (sub1 cur-year)) tzofs)))))
+
+(define re:passive #rx#"\\((.*),(.*),(.*),(.*),(.*),(.*)\\)")
+
+(define (establish-data-connection tcp-ports)
+  (fprintf (ftp-connection-out tcp-ports) "PASV\r\n")
+  (let ([response (ftp-check-response
+                   (ftp-connection-in tcp-ports)
+                   (ftp-connection-out tcp-ports)
+                   #"227"
+                   (lambda (s ignore) s) ; should be the only response
+                   (void))])
+    (let* ([reg-list (regexp-match re:passive response)]
+           [pn1 (and reg-list
+                     (bytes->number (list-ref reg-list 5)))]
+           [pn2 (bytes->number (list-ref reg-list 6))])
+      (unless (and reg-list pn1 pn2)
+        (error 'ftp "can't understand PASV response: ~e" response))
+      (let-values ([(tcp-data tcp-data-out)
+                    (tcp-connect (format "~a.~a.~a.~a"
+                                         (list-ref reg-list 1)
+                                         (list-ref reg-list 2)
+                                         (list-ref reg-list 3)
+                                         (list-ref reg-list 4))
+                                 (+ (* 256 pn1) pn2))])
+        (fprintf (ftp-connection-out tcp-ports) "TYPE I\r\n")
+        (ftp-check-response (ftp-connection-in tcp-ports)
+                            (ftp-connection-out tcp-ports)
+                            #"200" void (void))
+        (tcp-abandon-port tcp-data-out)
+        tcp-data))))
+
+;; Used where version 0.1a printed responses:
+(define (print-msg s ignore)
+  ;; (printf "~a\n" s)
+  (void))
+
+(define (ftp-establish-connection* in out username password)
+  (ftp-check-response in out #"220" print-msg (void))
+  (fprintf out "USER ~a\r\n" username)
+  (let ([no-password? (ftp-check-response
+                       in out (list #"331" #"230")
+                       (lambda (line 230?)
+                         (or 230? (regexp-match #rx#"^230" line)))
+                       #f)])
+    (unless no-password?
+      (fprintf out "PASS ~a\r\n" password)
+      (ftp-check-response in out #"230" void (void))))
+  (make-ftp-connection in out))
+
+(define (ftp-establish-connection server-address server-port username password)
+  (let-values ([(tcpin tcpout) (tcp-connect server-address server-port)])
+    (ftp-establish-connection* tcpin tcpout username password)))
+
+(define (ftp-close-connection tcp-ports)
+  (fprintf (ftp-connection-out tcp-ports) "QUIT\r\n")
+  (ftp-check-response (ftp-connection-in tcp-ports)
+                      (ftp-connection-out tcp-ports)
+                      #"221" void (void))
+  (close-input-port (ftp-connection-in tcp-ports))
+  (close-output-port (ftp-connection-out tcp-ports)))
+
+(define (ftp-cd ftp-ports new-dir)
+  (fprintf (ftp-connection-out ftp-ports) "CWD ~a\r\n" new-dir)
+  (ftp-check-response (ftp-connection-in ftp-ports)
+                      (ftp-connection-out ftp-ports)
+                      #"250" void (void)))
+
+(define re:dir-line
+  (regexp (string-append
+           "^(.)(.*) ((?i:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)"
+           " .* [0-9][0-9]:?[0-9][0-9]) (.*)$")))
+
+(define (ftp-directory-list tcp-ports [path #f])
+  (define tcp-data (establish-data-connection tcp-ports))
+  (if path
+    (fprintf (ftp-connection-out tcp-ports) "LIST ~a\r\n" path)
+    (fprintf (ftp-connection-out tcp-ports) "LIST\r\n"))
+  (ftp-check-response (ftp-connection-in tcp-ports)
+                      (ftp-connection-out tcp-ports)
+                      (list #"150" #"125") void (void))
+  (define lines (port->lines tcp-data))
+  (close-input-port tcp-data)
+  (ftp-check-response (ftp-connection-in tcp-ports)
+                      (ftp-connection-out tcp-ports)
+                      #"226" print-msg (void))
+  (for*/list ([l (in-list lines)]
+              [m (in-value (cond [(regexp-match re:dir-line l) => cdr]
+                                 [else #f]))]
+              #:when m)
+    (define size (cond [(and (equal? "-" (car m))
+                             (regexp-match #rx"([0-9]+) *$" (cadr m)))
+                        => cadr]
+                       [else #f]))
+    (define r `(,(car m) ,@(cddr m)))
+    (if size `(,@r ,size) r)))
+
+(define (ftp-download-file tcp-ports folder filename)
+  ;; Save the file under the name tmp.file, rename it once download is
+  ;; complete this assures we don't over write any existing file without
+  ;; having a good file down
+  (let* ([tmpfile (make-temporary-file
+                   (string-append
+                    (regexp-replace
+                     #rx"~"
+                     (path->string (build-path folder "ftptmp"))
+                     "~~")
+                    "~a"))]
+         [new-file (open-output-file tmpfile #:exists 'replace)]
+         [tcp-data (establish-data-connection tcp-ports)])
+    (fprintf (ftp-connection-out tcp-ports) "RETR ~a\r\n" filename)
+    (ftp-check-response (ftp-connection-in tcp-ports)
+                        (ftp-connection-out tcp-ports)
+                        (list #"125" #"150") print-msg (void))
+    (copy-port tcp-data new-file)
+    (close-output-port new-file)
+    (close-input-port tcp-data)
+    (ftp-check-response (ftp-connection-in tcp-ports)
+                        (ftp-connection-out tcp-ports)
+                        #"226" print-msg (void))
+    (rename-file-or-directory tmpfile (build-path folder filename) #t)))
diff --git a/collects/net/head-unit.rkt b/collects/net/head-unit.rkt
index 8f182333a1..1a1606b729 100644
--- a/collects/net/head-unit.rkt
+++ b/collects/net/head-unit.rkt
@@ -1,345 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/date racket/string "head-sig.rkt")
+(require racket/unit
+         "head-sig.rkt" "head.rkt")
 
-(import)
-(export head^)
+(define-unit-from-context head@ head^)
 
-;; NB: I've done a copied-code adaptation of a number of these definitions
-;; into "bytes-compatible" versions.  Finishing the rest will require some
-;; kind of interface decision---that is, when you don't supply a header,
-;; should the resulting operation be string-centric or bytes-centric?
-;; Easiest just to stop here.
-;; -- JBC 2006-07-31
-
-(define CRLF (string #\return #\newline))
-(define CRLF/bytes #"\r\n")
-
-(define empty-header CRLF)
-(define empty-header/bytes CRLF/bytes)
-
-(define re:field-start (regexp "^[^ \t\n\r\v:\001-\032\"]*:"))
-(define re:field-start/bytes #rx#"^[^ \t\n\r\v:\001-\032\"]*:")
-
-(define re:continue (regexp "^[ \t\v]"))
-(define re:continue/bytes #rx#"^[ \t\v]")
-
-(define (validate-header s)
-  (if (bytes? s)
-    ;; legal char check not needed per rfc 2822, IIUC.
-    (let ([len (bytes-length s)])
-      (let loop ([offset 0])
-        (cond
-          [(and (= (+ offset 2) len)
-                (bytes=? CRLF/bytes (subbytes s offset len)))
-           (void)] ; validated
-          [(= offset len) (error 'validate-header "missing ending CRLF")]
-          [(or (regexp-match re:field-start/bytes s offset)
-               (regexp-match re:continue/bytes s offset))
-           (let ([m (regexp-match-positions #rx#"\r\n" s offset)])
-             (if m
-               (loop (cdar m))
-               (error 'validate-header "missing ending CRLF")))]
-          [else (error 'validate-header "ill-formed header at ~s"
-                       (subbytes s offset (bytes-length s)))])))
-    ;; otherwise it should be a string:
-    (begin
-      (let ([m (regexp-match #rx"[^\000-\377]" s)])
-        (when m
-          (error 'validate-header "non-Latin-1 character in string: ~v" (car m))))
-      (let ([len (string-length s)])
-        (let loop ([offset 0])
-          (cond
-            [(and (= (+ offset 2) len)
-                  (string=? CRLF (substring s offset len)))
-             (void)] ; validated
-            [(= offset len) (error 'validate-header "missing ending CRLF")]
-            [(or (regexp-match re:field-start s offset)
-                 (regexp-match re:continue s offset))
-             (let ([m (regexp-match-positions #rx"\r\n" s offset)])
-               (if m
-                 (loop (cdar m))
-                 (error 'validate-header "missing ending CRLF")))]
-            [else (error 'validate-header "ill-formed header at ~s"
-                         (substring s offset (string-length s)))]))))))
-
-(define (make-field-start-regexp field)
-  (regexp (format "(^|[\r][\n])(~a: *)" (regexp-quote field #f))))
-
-(define (make-field-start-regexp/bytes field)
-  (byte-regexp (bytes-append #"(^|[\r][\n])("(regexp-quote field #f) #": *)")))
-
-(define (extract-field field header)
-  (if (bytes? header)
-    (let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
-                                     header)])
-      (and m
-           (let ([s (subbytes header
-                              (cdaddr m)
-                              (bytes-length header))])
-             (let ([m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)])
-               (if m
-                 (subbytes s 0 (caar m))
-                 ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                 (regexp-replace #rx#"\r\n\r\n$" s ""))))))
-    ;; otherwise header & field should be strings:
-    (let ([m (regexp-match-positions (make-field-start-regexp field)
-                                     header)])
-      (and m
-           (let ([s (substring header
-                               (cdaddr m)
-                               (string-length header))])
-             (let ([m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)])
-               (if m
-                 (substring s 0 (caar m))
-                 ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                 (regexp-replace #rx"\r\n\r\n$" s ""))))))))
-
-(define (replace-field field data header)
-  (if (bytes? header)
-    (let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
-                                     header)])
-      (if m
-        (let* ([pre (subbytes header 0 (caaddr m))]
-               [s (subbytes header (cdaddr m))]
-               [m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)]
-               [rest (if m (subbytes s (+ 2 (caar m))) empty-header/bytes)])
-          (bytes-append pre (if data (insert-field field data rest) rest)))
-        (if data (insert-field field data header) header)))
-    ;; otherwise header & field & data should be strings:
-    (let ([m (regexp-match-positions (make-field-start-regexp field) header)])
-      (if m
-        (let* ([pre (substring header 0 (caaddr m))]
-               [s (substring header (cdaddr m))]
-               [m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)]
-               [rest (if m (substring s (+ 2 (caar m))) empty-header)])
-          (string-append pre (if data (insert-field field data rest) rest)))
-        (if data (insert-field field data header) header)))))
-
-(define (remove-field field header)
-  (replace-field field #f header))
-
-(define (insert-field field data header)
-  (if (bytes? header)
-    (let ([field (bytes-append field #": "data #"\r\n")])
-      (bytes-append field header))
-    ;; otherwise field, data, & header should be strings:
-    (let ([field (format "~a: ~a\r\n" field data)])
-      (string-append field header))))
-
-(define (append-headers a b)
-  (if (bytes? a)
-    (let ([alen (bytes-length a)])
-      (if (> alen 1)
-        (bytes-append (subbytes a 0 (- alen 2)) b)
-        (error 'append-headers "first argument is not a header: ~a" a)))
-    ;; otherwise, a & b should be strings:
-    (let ([alen (string-length a)])
-      (if (> alen 1)
-        (string-append (substring a 0 (- alen 2)) b)
-        (error 'append-headers "first argument is not a header: ~a" a)))))
-
-(define (extract-all-fields header)
-  (if (bytes? header)
-    (let ([re #rx#"(^|[\r][\n])(([^\r\n:\"]*): *)"])
-      (let loop ([start 0])
-        (let ([m (regexp-match-positions re header start)])
-          (if m
-            (let ([start (cdaddr m)]
-                  [field-name (subbytes header (caaddr (cdr m))
-                                        (cdaddr (cdr m)))])
-              (let ([m2 (regexp-match-positions
-                         #rx#"\r\n[^: \r\n\"]*:"
-                         header
-                         start)])
-                (if m2
-                  (cons (cons field-name
-                              (subbytes header start (caar m2)))
-                        (loop (caar m2)))
-                  ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                  (list
-                   (cons field-name
-                         (regexp-replace #rx#"\r\n\r\n$"
-                                         (subbytes header start (bytes-length header))
-                                         ""))))))
-            ;; malformed header:
-            null))))
-    ;; otherwise, header should be a string:
-    (let ([re #rx"(^|[\r][\n])(([^\r\n:\"]*): *)"])
-      (let loop ([start 0])
-        (let ([m (regexp-match-positions re header start)])
-          (if m
-            (let ([start (cdaddr m)]
-                  [field-name (substring header (caaddr (cdr m)) (cdaddr (cdr m)))])
-              (let ([m2 (regexp-match-positions
-                         #rx"\r\n[^: \r\n\"]*:" header start)])
-                (if m2
-                  (cons (cons field-name
-                              (substring header start (caar m2)))
-                        (loop (caar m2)))
-                  ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                  (list
-                   (cons field-name
-                         (regexp-replace #rx"\r\n\r\n$"
-                                         (substring header start (string-length header))
-                                         ""))))))
-            ;; malformed header:
-            null))))))
-
-;; It's slightly less obvious how to generalize the functions that don't
-;; accept a header as input; for lack of an obvious solution (and free time),
-;; I'm stopping the string->bytes translation here.  -- JBC, 2006-07-31
-
-(define (standard-message-header from tos ccs bccs subject)
-  (let ([h (insert-field
-            "Subject" subject
-            (insert-field
-             "Date" (parameterize ([date-display-format 'rfc2822])
-                      (date->string (seconds->date (current-seconds)) #t))
-             CRLF))])
-    ;; NOTE: bccs don't go into the header; that's why they're "blind"
-    (let ([h (if (null? ccs)
-               h
-               (insert-field "CC" (assemble-address-field ccs) h))])
-      (let ([h (if (null? tos)
-                 h
-                 (insert-field "To" (assemble-address-field tos) h))])
-        (insert-field "From" from h)))))
-
-(define (splice l sep)
-  (if (null? l)
-    ""
-    (format "~a~a"
-            (car l)
-            (apply string-append
-                   (map (lambda (n) (format "~a~a" sep n))
-                        (cdr l))))))
-
-(define (data-lines->data datas)
-  (splice datas "\r\n\t"))
-
-;; Extracting Addresses ;;
-
-(define blank "[ \t\n\r\v]")
-(define nonblank "[^ \t\n\r\v]")
-(define re:all-blank (regexp (format "^~a*$" blank)))
-(define re:quoted (regexp "\"[^\"]*\""))
-(define re:parened (regexp "[(][^)]*[)]"))
-(define re:comma (regexp ","))
-(define re:comma-separated (regexp "([^,]*),(.*)"))
-
-(define (extract-addresses s form)
-  (unless (memq form '(name address full all))
-    (raise-type-error 'extract-addresses
-                      "form: 'name, 'address, 'full, or 'all"
-                      form))
-  (if (or (not s) (regexp-match re:all-blank s))
-    null
-    (let loop ([prefix ""][s s])
-      ;; Which comes first - a quote or a comma?
-      (let* ([mq1 (regexp-match-positions re:quoted s)]
-             [mq2 (regexp-match-positions re:parened s)]
-             [mq (if (and mq1 mq2)
-                   (if (< (caar mq1) (caar mq2)) mq1 mq2)
-                   (or mq1 mq2))]
-             [mc (regexp-match-positions re:comma s)])
-        (if (and mq mc (< (caar mq) (caar mc) (cdar mq)))
-          ;; Quote contains a comma
-          (loop (string-append
-                 prefix
-                 (substring s 0 (cdar mq)))
-                (substring s (cdar mq) (string-length s)))
-          ;; Normal comma parsing:
-          (let ([m (regexp-match re:comma-separated s)])
-            (if m
-              (let ([n (extract-one-name (string-append prefix (cadr m)) form)]
-                    [rest (extract-addresses (caddr m) form)])
-                (cons n rest))
-              (let ([n (extract-one-name (string-append prefix s) form)])
-                (list n)))))))))
-
-(define (select-result form name addr full)
-  (case form
-    [(name) name]
-    [(address) addr]
-    [(full) full]
-    [(all) (list name addr full)]))
-
-(define (one-result form s)
-  (select-result form s s s))
-
-(define re:quoted-name (regexp (format "^~a*(\"[^\"]*\")(.*)" blank)))
-(define re:parened-name (regexp (format "(.*)[(]([^)]*)[)]~a*$" blank)))
-(define re:simple-name (regexp (format "^~a*(~a.*)(<.*>)~a*$" blank nonblank blank)))
-(define re:normal-name (regexp (format "~a*<([^>]*)>~a*" blank blank)))
-(define re:double-less (regexp "<.*<"))
-(define re:double-greater (regexp ">.*>"))
-(define re:bad-chars (regexp "[,\"()<>]"))
-(define re:tail-blanks (regexp (format "~a+$" blank)))
-(define re:head-blanks (regexp (format "^~a+" blank)))
-
-(define (extract-one-name orig form)
-  (let loop ([s orig][form form])
-    (cond
-      ;; ?!?!? Where does the "addr (name)" standard come from ?!?!?
-      [(regexp-match re:parened-name s)
-       => (lambda (m)
-            (let ([name (caddr m)]
-                  [all (loop (cadr m) 'all)])
-              (select-result
-               form
-               (if (string=? (car all) (cadr all)) name (car all))
-               (cadr all)
-               (format "~a (~a)" (caddr all) name))))]
-      [(regexp-match re:quoted-name s)
-       => (lambda (m)
-            (let ([name (cadr m)]
-                  [addr (extract-angle-addr (caddr m) s)])
-              (select-result form name addr
-                             (format "~a <~a>" name addr))))]
-      [(regexp-match re:simple-name s)
-       => (lambda (m)
-            (let ([name (regexp-replace (format "~a*$" blank) (cadr m) "")]
-                  [addr (extract-angle-addr (caddr m) s)])
-              (select-result form name addr
-                             (format "~a <~a>" name addr))))]
-      [(or (regexp-match "<" s) (regexp-match ">" s))
-       (one-result form (extract-angle-addr s orig))]
-      [else (one-result form (extract-simple-addr s orig))])))
-
-(define (extract-angle-addr s orig)
-  (if (or (regexp-match re:double-less s) (regexp-match re:double-greater s))
-    (error 'extract-address "too many angle brackets: ~a" s)
-    (let ([m (regexp-match re:normal-name s)])
-      (if m
-        (extract-simple-addr (cadr m) orig)
-        (error 'extract-address "cannot parse address: ~a" orig)))))
-
-(define (extract-simple-addr s orig)
-  (cond [(regexp-match re:bad-chars s)
-         (error 'extract-address "cannot parse address: ~a" orig)]
-        [else
-         ;; final whitespace strip
-         (regexp-replace re:tail-blanks
-                         (regexp-replace re:head-blanks s "")
-                         "")]))
-
-(define (assemble-address-field addresses)
-  (if (null? addresses)
-    ""
-    (let loop ([addresses (cdr addresses)]
-               [s (car addresses)]
-               [len (string-length (car addresses))])
-      (if (null? addresses)
-        s
-        (let* ([addr (car addresses)]
-               [alen (string-length addr)])
-          (if (<= 72 (+ len alen))
-            (loop (cdr addresses)
-                  (format "~a,~a~a~a~a"
-                          s #\return #\linefeed
-                          #\tab addr)
-                  alen)
-            (loop (cdr addresses)
-                  (format "~a, ~a" s addr)
-                  (+ len alen 2))))))))
+(provide head@)
diff --git a/collects/net/head.rkt b/collects/net/head.rkt
index 5cc95b36dd..8365326c82 100644
--- a/collects/net/head.rkt
+++ b/collects/net/head.rkt
@@ -1,6 +1,355 @@
 #lang racket/base
-(require racket/unit "head-sig.rkt" "head-unit.rkt")
 
-(define-values/invoke-unit/infer head@)
+(require racket/date racket/string)
 
-(provide-signature-elements head^)
+(provide empty-header
+         validate-header
+         extract-field
+         remove-field
+         insert-field
+         replace-field
+         extract-all-fields
+         append-headers
+         standard-message-header
+         data-lines->data
+         extract-addresses
+         assemble-address-field)
+
+;; NB: I've done a copied-code adaptation of a number of these definitions
+;; into "bytes-compatible" versions.  Finishing the rest will require some
+;; kind of interface decision---that is, when you don't supply a header,
+;; should the resulting operation be string-centric or bytes-centric?
+;; Easiest just to stop here.
+;; -- JBC 2006-07-31
+
+(define CRLF (string #\return #\newline))
+(define CRLF/bytes #"\r\n")
+
+(define empty-header CRLF)
+(define empty-header/bytes CRLF/bytes)
+
+(define re:field-start (regexp "^[^ \t\n\r\v:\001-\032\"]*:"))
+(define re:field-start/bytes #rx#"^[^ \t\n\r\v:\001-\032\"]*:")
+
+(define re:continue (regexp "^[ \t\v]"))
+(define re:continue/bytes #rx#"^[ \t\v]")
+
+(define (validate-header s)
+  (if (bytes? s)
+    ;; legal char check not needed per rfc 2822, IIUC.
+    (let ([len (bytes-length s)])
+      (let loop ([offset 0])
+        (cond
+          [(and (= (+ offset 2) len)
+                (bytes=? CRLF/bytes (subbytes s offset len)))
+           (void)] ; validated
+          [(= offset len) (error 'validate-header "missing ending CRLF")]
+          [(or (regexp-match re:field-start/bytes s offset)
+               (regexp-match re:continue/bytes s offset))
+           (let ([m (regexp-match-positions #rx#"\r\n" s offset)])
+             (if m
+               (loop (cdar m))
+               (error 'validate-header "missing ending CRLF")))]
+          [else (error 'validate-header "ill-formed header at ~s"
+                       (subbytes s offset (bytes-length s)))])))
+    ;; otherwise it should be a string:
+    (begin
+      (let ([m (regexp-match #rx"[^\000-\377]" s)])
+        (when m
+          (error 'validate-header "non-Latin-1 character in string: ~v" (car m))))
+      (let ([len (string-length s)])
+        (let loop ([offset 0])
+          (cond
+            [(and (= (+ offset 2) len)
+                  (string=? CRLF (substring s offset len)))
+             (void)] ; validated
+            [(= offset len) (error 'validate-header "missing ending CRLF")]
+            [(or (regexp-match re:field-start s offset)
+                 (regexp-match re:continue s offset))
+             (let ([m (regexp-match-positions #rx"\r\n" s offset)])
+               (if m
+                 (loop (cdar m))
+                 (error 'validate-header "missing ending CRLF")))]
+            [else (error 'validate-header "ill-formed header at ~s"
+                         (substring s offset (string-length s)))]))))))
+
+(define (make-field-start-regexp field)
+  (regexp (format "(^|[\r][\n])(~a: *)" (regexp-quote field #f))))
+
+(define (make-field-start-regexp/bytes field)
+  (byte-regexp (bytes-append #"(^|[\r][\n])("(regexp-quote field #f) #": *)")))
+
+(define (extract-field field header)
+  (if (bytes? header)
+    (let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
+                                     header)])
+      (and m
+           (let ([s (subbytes header
+                              (cdaddr m)
+                              (bytes-length header))])
+             (let ([m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)])
+               (if m
+                 (subbytes s 0 (caar m))
+                 ;; Rest of header is this field, but strip trailing CRLFCRLF:
+                 (regexp-replace #rx#"\r\n\r\n$" s ""))))))
+    ;; otherwise header & field should be strings:
+    (let ([m (regexp-match-positions (make-field-start-regexp field)
+                                     header)])
+      (and m
+           (let ([s (substring header
+                               (cdaddr m)
+                               (string-length header))])
+             (let ([m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)])
+               (if m
+                 (substring s 0 (caar m))
+                 ;; Rest of header is this field, but strip trailing CRLFCRLF:
+                 (regexp-replace #rx"\r\n\r\n$" s ""))))))))
+
+(define (replace-field field data header)
+  (if (bytes? header)
+    (let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
+                                     header)])
+      (if m
+        (let* ([pre (subbytes header 0 (caaddr m))]
+               [s (subbytes header (cdaddr m))]
+               [m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)]
+               [rest (if m (subbytes s (+ 2 (caar m))) empty-header/bytes)])
+          (bytes-append pre (if data (insert-field field data rest) rest)))
+        (if data (insert-field field data header) header)))
+    ;; otherwise header & field & data should be strings:
+    (let ([m (regexp-match-positions (make-field-start-regexp field) header)])
+      (if m
+        (let* ([pre (substring header 0 (caaddr m))]
+               [s (substring header (cdaddr m))]
+               [m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)]
+               [rest (if m (substring s (+ 2 (caar m))) empty-header)])
+          (string-append pre (if data (insert-field field data rest) rest)))
+        (if data (insert-field field data header) header)))))
+
+(define (remove-field field header)
+  (replace-field field #f header))
+
+(define (insert-field field data header)
+  (if (bytes? header)
+    (let ([field (bytes-append field #": "data #"\r\n")])
+      (bytes-append field header))
+    ;; otherwise field, data, & header should be strings:
+    (let ([field (format "~a: ~a\r\n" field data)])
+      (string-append field header))))
+
+(define (append-headers a b)
+  (if (bytes? a)
+    (let ([alen (bytes-length a)])
+      (if (> alen 1)
+        (bytes-append (subbytes a 0 (- alen 2)) b)
+        (error 'append-headers "first argument is not a header: ~a" a)))
+    ;; otherwise, a & b should be strings:
+    (let ([alen (string-length a)])
+      (if (> alen 1)
+        (string-append (substring a 0 (- alen 2)) b)
+        (error 'append-headers "first argument is not a header: ~a" a)))))
+
+(define (extract-all-fields header)
+  (if (bytes? header)
+    (let ([re #rx#"(^|[\r][\n])(([^\r\n:\"]*): *)"])
+      (let loop ([start 0])
+        (let ([m (regexp-match-positions re header start)])
+          (if m
+            (let ([start (cdaddr m)]
+                  [field-name (subbytes header (caaddr (cdr m))
+                                        (cdaddr (cdr m)))])
+              (let ([m2 (regexp-match-positions
+                         #rx#"\r\n[^: \r\n\"]*:"
+                         header
+                         start)])
+                (if m2
+                  (cons (cons field-name
+                              (subbytes header start (caar m2)))
+                        (loop (caar m2)))
+                  ;; Rest of header is this field, but strip trailing CRLFCRLF:
+                  (list
+                   (cons field-name
+                         (regexp-replace #rx#"\r\n\r\n$"
+                                         (subbytes header start (bytes-length header))
+                                         ""))))))
+            ;; malformed header:
+            null))))
+    ;; otherwise, header should be a string:
+    (let ([re #rx"(^|[\r][\n])(([^\r\n:\"]*): *)"])
+      (let loop ([start 0])
+        (let ([m (regexp-match-positions re header start)])
+          (if m
+            (let ([start (cdaddr m)]
+                  [field-name (substring header (caaddr (cdr m)) (cdaddr (cdr m)))])
+              (let ([m2 (regexp-match-positions
+                         #rx"\r\n[^: \r\n\"]*:" header start)])
+                (if m2
+                  (cons (cons field-name
+                              (substring header start (caar m2)))
+                        (loop (caar m2)))
+                  ;; Rest of header is this field, but strip trailing CRLFCRLF:
+                  (list
+                   (cons field-name
+                         (regexp-replace #rx"\r\n\r\n$"
+                                         (substring header start (string-length header))
+                                         ""))))))
+            ;; malformed header:
+            null))))))
+
+;; It's slightly less obvious how to generalize the functions that don't
+;; accept a header as input; for lack of an obvious solution (and free time),
+;; I'm stopping the string->bytes translation here.  -- JBC, 2006-07-31
+
+(define (standard-message-header from tos ccs bccs subject)
+  (let ([h (insert-field
+            "Subject" subject
+            (insert-field
+             "Date" (parameterize ([date-display-format 'rfc2822])
+                      (date->string (seconds->date (current-seconds)) #t))
+             CRLF))])
+    ;; NOTE: bccs don't go into the header; that's why they're "blind"
+    (let ([h (if (null? ccs)
+               h
+               (insert-field "CC" (assemble-address-field ccs) h))])
+      (let ([h (if (null? tos)
+                 h
+                 (insert-field "To" (assemble-address-field tos) h))])
+        (insert-field "From" from h)))))
+
+(define (splice l sep)
+  (if (null? l)
+    ""
+    (format "~a~a"
+            (car l)
+            (apply string-append
+                   (map (lambda (n) (format "~a~a" sep n))
+                        (cdr l))))))
+
+(define (data-lines->data datas)
+  (splice datas "\r\n\t"))
+
+;; Extracting Addresses ;;
+
+(define blank "[ \t\n\r\v]")
+(define nonblank "[^ \t\n\r\v]")
+(define re:all-blank (regexp (format "^~a*$" blank)))
+(define re:quoted (regexp "\"[^\"]*\""))
+(define re:parened (regexp "[(][^)]*[)]"))
+(define re:comma (regexp ","))
+(define re:comma-separated (regexp "([^,]*),(.*)"))
+
+(define (extract-addresses s form)
+  (unless (memq form '(name address full all))
+    (raise-type-error 'extract-addresses
+                      "form: 'name, 'address, 'full, or 'all"
+                      form))
+  (if (or (not s) (regexp-match re:all-blank s))
+    null
+    (let loop ([prefix ""][s s])
+      ;; Which comes first - a quote or a comma?
+      (let* ([mq1 (regexp-match-positions re:quoted s)]
+             [mq2 (regexp-match-positions re:parened s)]
+             [mq (if (and mq1 mq2)
+                   (if (< (caar mq1) (caar mq2)) mq1 mq2)
+                   (or mq1 mq2))]
+             [mc (regexp-match-positions re:comma s)])
+        (if (and mq mc (< (caar mq) (caar mc) (cdar mq)))
+          ;; Quote contains a comma
+          (loop (string-append
+                 prefix
+                 (substring s 0 (cdar mq)))
+                (substring s (cdar mq) (string-length s)))
+          ;; Normal comma parsing:
+          (let ([m (regexp-match re:comma-separated s)])
+            (if m
+              (let ([n (extract-one-name (string-append prefix (cadr m)) form)]
+                    [rest (extract-addresses (caddr m) form)])
+                (cons n rest))
+              (let ([n (extract-one-name (string-append prefix s) form)])
+                (list n)))))))))
+
+(define (select-result form name addr full)
+  (case form
+    [(name) name]
+    [(address) addr]
+    [(full) full]
+    [(all) (list name addr full)]))
+
+(define (one-result form s)
+  (select-result form s s s))
+
+(define re:quoted-name (regexp (format "^~a*(\"[^\"]*\")(.*)" blank)))
+(define re:parened-name (regexp (format "(.*)[(]([^)]*)[)]~a*$" blank)))
+(define re:simple-name (regexp (format "^~a*(~a.*)(<.*>)~a*$" blank nonblank blank)))
+(define re:normal-name (regexp (format "~a*<([^>]*)>~a*" blank blank)))
+(define re:double-less (regexp "<.*<"))
+(define re:double-greater (regexp ">.*>"))
+(define re:bad-chars (regexp "[,\"()<>]"))
+(define re:tail-blanks (regexp (format "~a+$" blank)))
+(define re:head-blanks (regexp (format "^~a+" blank)))
+
+(define (extract-one-name orig form)
+  (let loop ([s orig][form form])
+    (cond
+      ;; ?!?!? Where does the "addr (name)" standard come from ?!?!?
+      [(regexp-match re:parened-name s)
+       => (lambda (m)
+            (let ([name (caddr m)]
+                  [all (loop (cadr m) 'all)])
+              (select-result
+               form
+               (if (string=? (car all) (cadr all)) name (car all))
+               (cadr all)
+               (format "~a (~a)" (caddr all) name))))]
+      [(regexp-match re:quoted-name s)
+       => (lambda (m)
+            (let ([name (cadr m)]
+                  [addr (extract-angle-addr (caddr m) s)])
+              (select-result form name addr
+                             (format "~a <~a>" name addr))))]
+      [(regexp-match re:simple-name s)
+       => (lambda (m)
+            (let ([name (regexp-replace (format "~a*$" blank) (cadr m) "")]
+                  [addr (extract-angle-addr (caddr m) s)])
+              (select-result form name addr
+                             (format "~a <~a>" name addr))))]
+      [(or (regexp-match "<" s) (regexp-match ">" s))
+       (one-result form (extract-angle-addr s orig))]
+      [else (one-result form (extract-simple-addr s orig))])))
+
+(define (extract-angle-addr s orig)
+  (if (or (regexp-match re:double-less s) (regexp-match re:double-greater s))
+    (error 'extract-address "too many angle brackets: ~a" s)
+    (let ([m (regexp-match re:normal-name s)])
+      (if m
+        (extract-simple-addr (cadr m) orig)
+        (error 'extract-address "cannot parse address: ~a" orig)))))
+
+(define (extract-simple-addr s orig)
+  (cond [(regexp-match re:bad-chars s)
+         (error 'extract-address "cannot parse address: ~a" orig)]
+        [else
+         ;; final whitespace strip
+         (regexp-replace re:tail-blanks
+                         (regexp-replace re:head-blanks s "")
+                         "")]))
+
+(define (assemble-address-field addresses)
+  (if (null? addresses)
+    ""
+    (let loop ([addresses (cdr addresses)]
+               [s (car addresses)]
+               [len (string-length (car addresses))])
+      (if (null? addresses)
+        s
+        (let* ([addr (car addresses)]
+               [alen (string-length addr)])
+          (if (<= 72 (+ len alen))
+            (loop (cdr addresses)
+                  (format "~a,~a~a~a~a"
+                          s #\return #\linefeed
+                          #\tab addr)
+                  alen)
+            (loop (cdr addresses)
+                  (format "~a, ~a" s addr)
+                  (+ len alen 2))))))))
diff --git a/collects/net/imap-unit.rkt b/collects/net/imap-unit.rkt
index b9a7b83d84..4b28b4f2cd 100644
--- a/collects/net/imap-unit.rkt
+++ b/collects/net/imap-unit.rkt
@@ -1,554 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/tcp "imap-sig.rkt" "private/rbtree.rkt")
+(require racket/unit
+         "imap-sig.rkt" "imap.rkt")
 
-(import)
-(export imap^)
+(define-unit-from-context imap@ imap^)
 
-(define debug-via-stdio? #f)
-
-(define eol (if debug-via-stdio? 'linefeed 'return-linefeed))
-
-(define (tag-eq? a b)
-  (or (eq? a b)
-      (and (symbol? a)
-           (symbol? b)
-           (string-ci=? (symbol->string a) (symbol->string b)))))
-
-(define field-names
-  (list (list 'uid (string->symbol "UID"))
-        (list 'header (string->symbol "RFC822.HEADER"))
-        (list 'body (string->symbol "RFC822.TEXT"))
-        (list 'size (string->symbol "RFC822.SIZE"))
-        (list 'flags (string->symbol "FLAGS"))))
-
-(define flag-names
-  (list (list 'seen (string->symbol "\\Seen"))
-        (list 'answered (string->symbol "\\Answered"))
-        (list 'flagged (string->symbol "\\Flagged"))
-        (list 'deleted (string->symbol "\\Deleted"))
-        (list 'draft (string->symbol "\\Draft"))
-        (list 'recent (string->symbol "\\Recent"))
-
-        (list 'noinferiors (string->symbol "\\Noinferiors"))
-        (list 'noselect (string->symbol "\\Noselect"))
-        (list 'marked (string->symbol "\\Marked"))
-        (list 'unmarked (string->symbol "\\Unmarked"))
-
-        (list 'hasnochildren (string->symbol "\\HasNoChildren"))
-        (list 'haschildren (string->symbol "\\HasChildren"))))
-
-(define (imap-flag->symbol f)
-  (or (ormap (lambda (a) (and (tag-eq? f (cadr a)) (car a))) flag-names)
-      f))
-
-(define (symbol->imap-flag s)
-  (cond [(assoc s flag-names) => cadr] [else s]))
-
-(define (log-warning . args)
-  ;; (apply printf args)
-  (void))
-(define log log-warning)
-
-(define make-msg-id
-  (let ([id 0])
-    (lambda ()
-      (begin0 (string->bytes/latin-1 (format "a~a " id))
-        (set! id (add1 id))))))
-
-(define (starts-with? l n)
-  (and (>= (bytes-length l) (bytes-length n))
-       (bytes=? n (subbytes l 0 (bytes-length n)))))
-
-(define (skip s n)
-  (subbytes s (if (number? n) n (bytes-length n))))
-
-(define (splice l sep)
-  (if (null? l)
-    ""
-    (format "~a~a"
-            (car l)
-            (apply string-append
-                   (map (lambda (n) (format "~a~a" sep n)) (cdr l))))))
-
-(define (imap-read s r)
-  (let loop ([s s]
-             [r r]
-             [accum null]
-             [eol-k (lambda (accum) (reverse accum))]
-             [eop-k (lambda (s accum) (error 'imap-read "unxpected close parenthesis"))])
-    (cond
-      [(bytes=? #"" s)
-       (eol-k accum)]
-      [(char-whitespace? (integer->char (bytes-ref s 0)))
-       (loop (skip s 1) r accum eol-k eop-k)]
-      [else
-       (case (integer->char (bytes-ref s 0))
-         [(#\")
-          (let ([m (regexp-match #rx#"\"([^\"]*)\"(.*)" s)])
-            (if m
-              (loop (caddr m) r (cons (cadr m) accum) eol-k eop-k)
-              (error 'imap-read "didn't find end of quoted string in: ~a" s)))]
-         [(#\))
-          (eop-k (skip s 1) accum)]
-         [(#\() (letrec ([next-line
-                          (lambda (accum)
-                            (loop (read-bytes-line r eol) r
-                                  accum
-                                  next-line
-                                  finish-parens))]
-                         [finish-parens
-                          (lambda (s laccum)
-                            (loop s r
-                                  (cons (reverse laccum) accum)
-                                  eol-k eop-k))])
-                  (loop (skip s 1) r null next-line finish-parens))]
-         [(#\{) (let ([m (regexp-match #rx#"{([0-9]+)}(.*)" s)])
-                  (cond
-                    [(not m) (error 'imap-read "couldn't read {} number: ~a" s)]
-                    [(not (bytes=? (caddr m) #"")) (error 'imap-read "{} not at end-of-line: ~a" s)]
-                    [else
-                     (loop #"" r
-                           (cons (read-bytes (string->number
-                                              (bytes->string/latin-1 (cadr m)))
-                                             r)
-                                 accum)
-                           eol-k eop-k)]))]
-         [else (let ([m (regexp-match #rx#"([^ (){}]+)(.*)" s)])
-                 (if m
-                   (loop (caddr m) r
-                         (cons (let ([v (cadr m)])
-                                 (if (regexp-match #rx#"^[0-9]*$" v)
-                                   (string->number (bytes->string/latin-1 v))
-                                   (string->symbol (bytes->string/latin-1 v))))
-                               accum)
-                         eol-k eop-k)
-                   (error 'imap-read "failure reading atom: ~a" s)))])])))
-
-(define (get-response r id info-handler continuation-handler)
-  (let loop ()
-    (let ([l (read-bytes-line r eol)])
-      (log "raw-reply: ~s\n" l)
-      (cond [(eof-object? l)
-             (error 'imap-send "unexpected end-of-file from server")]
-            [(and id (starts-with? l id))
-             (let ([reply (imap-read (skip l id) r)])
-               (log "response: ~a\n" reply)
-               reply)]
-            [(starts-with? l #"* ")
-             (let ([info (imap-read (skip l 2) r)])
-               (log "info: ~s\n" info)
-               (info-handler info))
-             (when id (loop))]
-            [(starts-with? l #"+ ")
-             (if (null? continuation-handler)
-               (error 'imap-send "unexpected continuation request: ~a" l)
-               ((car continuation-handler) loop (imap-read (skip l 2) r)))]
-            [else
-             (log-warning "warning: unexpected response for ~a: ~a\n" id l)
-             (when id (loop))]))))
-
-;; A cmd is
-;;  * (box v) - send v literally via ~a
-;;  * string or bytes - protect as necessary
-;;  * (cons cmd null) - same as cmd
-;;  * (cons cmd cmd) - send cmd, space, cmd
-
-(define (imap-send imap cmd info-handler . continuation-handler)
-  (let ([r (imap-r imap)]
-        [w (imap-w imap)]
-        [id (make-msg-id)])
-    (log "sending ~a~a\n" id cmd)
-    (fprintf w "~a" id)
-    (let loop ([cmd cmd])
-      (cond
-        [(box? cmd) (fprintf w "~a" (unbox cmd))]
-        [(string? cmd) (loop (string->bytes/utf-8 cmd))]
-        [(bytes? cmd)
-         (if (or (regexp-match #rx#"[ *\"\r\n]" cmd)
-                 (equal? cmd #""))
-           (if (regexp-match #rx#"[\"\r\n]" cmd)
-             (begin
-               ;; Have to send size, then continue if the
-               ;;  server consents
-               (fprintf w "{~a}\r\n" (bytes-length cmd))
-               (flush-output w)
-               (get-response r #f void (list (lambda (gloop data) (void))))
-               ;; Continue by writing the data
-               (write-bytes cmd w))
-             (fprintf w "\"~a\"" cmd))
-           (fprintf w "~a" cmd))]
-        [(and (pair? cmd) (null? (cdr cmd))) (loop (car cmd))]
-        [(pair? cmd) (begin (loop (car cmd))
-                            (fprintf w " ")
-                            (loop (cdr cmd)))]))
-    (fprintf w "\r\n")
-    (flush-output w)
-    (get-response r id (wrap-info-handler imap info-handler)
-                  continuation-handler)))
-
-(define (check-ok reply)
-  (unless (and (pair? reply) (tag-eq? (car reply) 'OK))
-    (error 'check-ok "server error: ~s" reply)))
-
-(define (ok-tag-eq? i t)
-  (and (tag-eq? (car i) 'OK)
-       ((length i) . >= . 3)
-       (tag-eq? (cadr i) (string->symbol (format "[~a" t)))))
-
-(define (ok-tag-val i)
-  (let ([v (caddr i)])
-    (and (symbol? v)
-         (let ([v (symbol->string v)])
-           (regexp-match #rx"[]]$" v)
-           (string->number (substring v 0 (sub1 (string-length v))))))))
-
-(define (wrap-info-handler imap info-handler)
-  (lambda (i)
-    (when (and (list? i) ((length i) . >= . 2))
-      (cond
-        [(tag-eq? (cadr i) 'EXISTS)
-         (when (> (car i) (or (imap-exists imap) 0))
-           (set-imap-new?! imap #t))
-         (set-imap-exists! imap (car i))]
-        [(tag-eq? (cadr i) 'RECENT)
-         (set-imap-recent! imap (car i))]
-        [(tag-eq? (cadr i) 'EXPUNGE)
-         (let ([n (car i)])
-           (log "Recording expunge: ~s\n" n)
-           ;; add it to the tree of expunges
-           (expunge-insert! (imap-expunges imap) n)
-           ;; decrement exists count:
-           (set-imap-exists! imap (sub1 (imap-exists imap)))
-           ;; adjust ids for any remembered fetches:
-           (fetch-shift! (imap-fetches imap) n))]
-        [(tag-eq? (cadr i) 'FETCH)
-         (fetch-insert!
-          (imap-fetches imap)
-          ;; Convert result to assoc list:
-          (cons (car i)
-                (let ([new
-                       (let loop ([l (caddr i)])
-                         (if (null? l)
-                           null
-                           (cons (cons (car l) (cadr l))
-                                 (loop (cddr l)))))])
-                  ;; Keep anything not overridden:
-                  (let ([old (cdr (or (fetch-find (imap-fetches imap) (car i))
-                                      '(0)))])
-                    (let loop ([old old][new new])
-                      (cond
-                        [(null? old) new]
-                        [(assq (caar old) new)
-                         (loop (cdr old) new)]
-                        [else (loop (cdr old) (cons (car old) new))]))))))]
-        [(ok-tag-eq? i 'UIDNEXT)
-         (set-imap-uidnext! imap (ok-tag-val i))]
-        [(ok-tag-eq? i 'UIDVALIDITY)
-         (set-imap-uidvalidity! imap (ok-tag-val i))]
-        [(ok-tag-eq? i 'UNSEEN)
-         (set-imap-uidvalidity! imap (ok-tag-val i))]))
-    (info-handler i)))
-
-(define-struct imap (r w exists recent unseen uidnext uidvalidity
-                     expunges fetches new?) 
-  #:mutable)
-(define (imap-connection? v) (imap? v))
-
-(define imap-port-number
-  (make-parameter 143
-                  (lambda (v)
-                    (unless (and (number? v)
-                                 (exact? v)
-                                 (integer? v)
-                                 (<= 1 v 65535))
-                      (raise-type-error 'imap-port-number
-                                        "exact integer in [1,65535]"
-                                        v))
-                    v)))
-
-(define (imap-connect* r w username password inbox)
-  (with-handlers ([void
-                   (lambda (x)
-                     (close-input-port r)
-                     (close-output-port w)
-                     (raise x))])
-
-    (let ([imap (make-imap r w #f #f #f #f #f
-                           (new-tree) (new-tree) #f)])
-      (check-ok (imap-send imap "NOOP" void))
-      (let ([reply (imap-send imap (list "LOGIN" username password) void)])
-        (if (and (pair? reply) (tag-eq? 'NO (car reply)))
-          (error 'imap-connect
-                 "username or password rejected by server: ~s" reply)
-          (check-ok reply)))
-      (let-values ([(init-count init-recent) (imap-reselect imap inbox)])
-        (values imap init-count init-recent)))))
-
-(define (imap-connect server username password inbox)
-  ;; => imap count-k recent-k
-  (let-values ([(r w)
-                (if debug-via-stdio?
-                  (begin
-                    (printf "stdin == ~a\n" server)
-                    (values  (current-input-port) (current-output-port)))
-                  (tcp-connect server (imap-port-number)))])
-    (imap-connect* r w username password inbox)))
-
-(define (imap-reselect imap inbox)
-  (imap-selectish-command imap (list "SELECT" inbox) #t))
-
-(define (imap-examine imap inbox)
-  (imap-selectish-command imap (list "EXAMINE" inbox) #t))
-
-;; Used to return (values #f #f) if no change since last check?
-(define (imap-noop imap)
-  (imap-selectish-command imap "NOOP" #f))
-
-(define (imap-selectish-command imap cmd reset?)
-  (let ([init-count #f]
-        [init-recent #f])
-    (check-ok (imap-send imap cmd void))
-    (when reset?
-      (set-imap-expunges! imap (new-tree))
-      (set-imap-fetches! imap (new-tree))
-      (set-imap-new?! imap #f))
-    (values (imap-exists imap) (imap-recent imap))))
-
-(define (imap-status imap inbox flags)
-  (unless (and (list? flags)
-               (andmap (lambda (s)
-                         (memq s '(messages recent uidnext uidvalidity unseen)))
-                       flags))
-    (raise-type-error 'imap-status "list of status flag symbols" flags))
-  (let ([results null])
-    (check-ok (imap-send imap (list "STATUS" inbox (box (format "~a" flags)))
-                         (lambda (i)
-                           (when (and (list? i) (= 3 (length i))
-                                      (tag-eq? (car i) 'STATUS))
-                             (set! results (caddr i))))))
-    (map (lambda (f)
-           (let loop ([l results])
-             (cond
-               [(or (null? l) (null? (cdr l))) #f]
-               [(tag-eq? f (car l)) (cadr l)]
-               [else (loop (cdr l))])))
-         flags)))
-
-(define (imap-poll imap)
-  (when (and ;; Check for async messages from the server
-             (char-ready? (imap-r imap))
-             ;; It has better start with "*"...
-             (= (peek-byte (imap-r imap)) (char->integer #\*)))
-    ;; May set fields in `imap':
-    (get-response (imap-r imap) #f (wrap-info-handler imap void) null)
-    (void)))
-
-(define (imap-get-updates imap)
-  (no-expunges 'imap-updates imap)
-  (let ([l (fetch-tree->list (imap-fetches imap))])
-    (set-imap-fetches! imap (new-tree))
-    l))
-
-(define (imap-pending-updates? imap)
-  (not (tree-empty? (imap-fetches imap))))
-
-(define (imap-get-expunges imap)
-  (let ([l (expunge-tree->list (imap-expunges imap))])
-    (set-imap-expunges! imap (new-tree))
-    l))
-
-(define (imap-pending-expunges? imap)
-  (not (tree-empty? (imap-expunges imap))))
-
-(define (imap-reset-new! imap)
-  (set-imap-new?! imap #f))
-
-(define (imap-messages imap)
-  (imap-exists imap))
-
-(define (imap-disconnect imap)
-  (let ([r (imap-r imap)]
-        [w (imap-w imap)])
-    (check-ok (imap-send imap "LOGOUT" void))
-    (close-input-port r)
-    (close-output-port w)))
-
-(define (imap-force-disconnect imap)
-  (let ([r (imap-r imap)]
-        [w (imap-w imap)])
-    (close-input-port r)
-    (close-output-port w)))
-
-(define (no-expunges who imap)
-  (unless (tree-empty? (imap-expunges imap))
-    (raise-mismatch-error who "session has pending expunge reports: " imap)))
-
-(define (msg-set msgs)
-  (apply
-   string-append
-   (let loop ([prev #f][msgs msgs])
-     (cond
-       [(null? msgs) null]
-       [(and prev
-             (pair? (cdr msgs))
-             (= (add1 prev) (car msgs)))
-        (loop (car msgs) (cdr msgs))]
-       [prev (cons (format ":~a," prev)
-                   (loop #f msgs))]
-       [(null? (cdr msgs)) (list (format "~a" (car msgs)))]
-       [(= (add1 (car msgs)) (cadr msgs))
-        (cons (format "~a" (car msgs))
-              (loop (car msgs) (cdr msgs)))]
-       [else (cons (format "~a," (car msgs))
-                   (loop #f (cdr msgs)))]))))
-
-(define (imap-get-messages imap msgs field-list)
-  (no-expunges 'imap-get-messages imap)
-  (when (or (not (list? msgs))
-            (not (andmap integer? msgs)))
-    (raise-type-error 'imap-get-messages "non-empty message list" msgs))
-  (when (or (null? field-list)
-            (not (list? field-list))
-            (not (andmap (lambda (f) (assoc f field-names)) field-list)))
-    (raise-type-error 'imap-get-messages "non-empty field list" field-list))
-
-  (if (null? msgs)
-    null
-    (begin
-      ;; FETCH request adds info to `(imap-fectches imap)':
-      (imap-send imap
-                 (list "FETCH"
-                       (box (msg-set msgs))
-                       (box
-                        (format "(~a)"
-                                (splice (map (lambda (f)
-                                               (cadr (assoc f field-names)))
-                                             field-list)
-                                        " "))))
-                 void)
-      ;; Sort out the collected info:
-      (let ([flds (map (lambda (f) (cadr (assoc f field-names)))
-                       field-list)])
-        (begin0
-            ;; For each msg, try to get each field value:
-            (map
-             (lambda (msg)
-               (let ([m (or (fetch-find (imap-fetches imap) msg)
-                            (error 'imap-get-messages "no result for message ~a" msg))])
-                 (let loop ([flds flds][m (cdr m)])
-                   (cond
-                     [(null? flds)
-                      (if (null? m)
-                        (fetch-delete! (imap-fetches imap) msg)
-                        (fetch-insert! (imap-fetches imap) (cons msg m)))
-                      null]
-                     [else
-                      (let ([a (assoc (car flds) m)])
-                        (cons (and a (cdr a))
-                              (loop (cdr flds) (if a (remq a m) m))))]))))
-             msgs))))))
-
-(define (imap-store imap mode msgs flags)
-  (no-expunges 'imap-store imap)
-  (check-ok
-   (imap-send imap
-              (list "STORE"
-                    (box (msg-set msgs))
-                    (case mode
-                      [(+) "+FLAGS.SILENT"]
-                      [(-) "-FLAGS.SILENT"]
-                      [(!) "FLAGS.SILENT"]
-                      [else (raise-type-error 'imap-store
-                                              "mode: '!, '+, or '-" mode)])
-                    (box (format "~a" flags)))
-              void)))
-
-(define (imap-copy imap msgs dest-mailbox)
-  (no-expunges 'imap-copy imap)
-  (check-ok
-   (imap-send imap (list "COPY" (box (msg-set msgs)) dest-mailbox) void)))
-
-(define (imap-append imap dest-mailbox msg)
-  (no-expunges 'imap-append imap)
-  (let ([msg (if (bytes? msg) msg (string->bytes/utf-8 msg))])
-    (check-ok
-     (imap-send imap (list "APPEND"
-                           dest-mailbox
-                           (box "(\\Seen)")
-                           (box (format "{~a}" (bytes-length msg))))
-                void
-                (lambda (loop contin)
-                  (fprintf (imap-w imap) "~a\r\n" msg)
-                  (loop))))))
-
-(define (imap-expunge imap)
-  (check-ok (imap-send imap "EXPUNGE" void)))
-
-(define (imap-mailbox-exists? imap mailbox)
-  (let ([exists? #f])
-    (check-ok (imap-send imap
-                         (list "LIST" "" mailbox)
-                         (lambda (i)
-                           (when (and (pair? i) (tag-eq? (car i) 'LIST))
-                             (set! exists? #t)))))
-    exists?))
-
-(define (imap-create-mailbox imap mailbox)
-  (check-ok (imap-send imap (list "CREATE" mailbox) void)))
-
-(define (imap-get-hierarchy-delimiter imap)
-  (let ([result #f])
-    (check-ok
-     (imap-send imap (list "LIST" "" "")
-                (lambda (i)
-                  (when (and (pair? i) (tag-eq? (car i) 'LIST))
-                    (set! result (caddr i))))))
-    result))
-
-(define imap-list-child-mailboxes
-  (case-lambda
-    [(imap mailbox)
-     (imap-list-child-mailboxes imap mailbox #f)]
-    [(imap mailbox raw-delimiter)
-     (let* ([delimiter (or raw-delimiter (imap-get-hierarchy-delimiter imap))]
-            [mailbox-name (and mailbox (bytes-append mailbox delimiter))]
-            [pattern (if mailbox
-                       (bytes-append mailbox-name #"%")
-                       #"%")])
-       (map (lambda (p)
-              (list (car p)
-                    (cond
-                      [(symbol? (cadr p))
-                       (string->bytes/utf-8 (symbol->string (cadr p)))]
-                      [(string? (cadr p))
-                       (string->bytes/utf-8 (symbol->string (cadr p)))]
-                      [(bytes? (cadr p))
-                       (cadr p)])))
-            (imap-list-mailboxes imap pattern mailbox-name)))]))
-
-(define (imap-mailbox-flags imap mailbox)
-  (let ([r (imap-list-mailboxes imap mailbox #f)])
-    (if (= (length r) 1)
-      (caar r)
-      (error 'imap-mailbox-flags "could not get flags for ~s (~a)"
-             mailbox
-             (if (null? r) "no matches" "multiple matches")))))
-
-(define (imap-list-mailboxes imap pattern except)
-  (let* ([sub-folders null])
-    (check-ok
-     (imap-send imap (list "LIST" "" pattern)
-                (lambda (x)
-                  (when (and (pair? x)
-                             (tag-eq? (car x) 'LIST))
-                    (let* ([flags (cadr x)]
-                           [name (cadddr x)]
-                           [bytes-name (if (symbol? name)
-                                         (string->bytes/utf-8 (symbol->string name))
-                                         name)])
-                      (unless (and except
-                                   (bytes=? bytes-name except))
-                        (set! sub-folders
-                              (cons (list flags name) sub-folders))))))))
-    (reverse sub-folders)))
+(provide imap@)
diff --git a/collects/net/imap.rkt b/collects/net/imap.rkt
index 6c02a92485..37e8b00be7 100644
--- a/collects/net/imap.rkt
+++ b/collects/net/imap.rkt
@@ -1,7 +1,12 @@
 #lang racket/base
-(require racket/unit racket/contract "imap-sig.rkt" "imap-unit.rkt")
 
-(define-values/invoke-unit/infer imap@)
+(require racket/contract/base racket/tcp "private/rbtree.rkt")
+
+;; define the imap struct and its predicate here, for use in the contract, below
+(define-struct imap (r w exists recent unseen uidnext uidvalidity
+                     expunges fetches new?)
+  #:mutable)
+(define (imap-connection? v) (imap? v))
 
 (provide/contract
  [imap-get-hierarchy-delimiter (imap-connection? . -> . bytes?)]
@@ -48,3 +53,546 @@
  imap-create-mailbox
 
  imap-mailbox-flags)
+
+(define debug-via-stdio? #f)
+
+(define eol (if debug-via-stdio? 'linefeed 'return-linefeed))
+
+(define (tag-eq? a b)
+  (or (eq? a b)
+      (and (symbol? a)
+           (symbol? b)
+           (string-ci=? (symbol->string a) (symbol->string b)))))
+
+(define field-names
+  (list (list 'uid (string->symbol "UID"))
+        (list 'header (string->symbol "RFC822.HEADER"))
+        (list 'body (string->symbol "RFC822.TEXT"))
+        (list 'size (string->symbol "RFC822.SIZE"))
+        (list 'flags (string->symbol "FLAGS"))))
+
+(define flag-names
+  (list (list 'seen (string->symbol "\\Seen"))
+        (list 'answered (string->symbol "\\Answered"))
+        (list 'flagged (string->symbol "\\Flagged"))
+        (list 'deleted (string->symbol "\\Deleted"))
+        (list 'draft (string->symbol "\\Draft"))
+        (list 'recent (string->symbol "\\Recent"))
+
+        (list 'noinferiors (string->symbol "\\Noinferiors"))
+        (list 'noselect (string->symbol "\\Noselect"))
+        (list 'marked (string->symbol "\\Marked"))
+        (list 'unmarked (string->symbol "\\Unmarked"))
+
+        (list 'hasnochildren (string->symbol "\\HasNoChildren"))
+        (list 'haschildren (string->symbol "\\HasChildren"))))
+
+(define (imap-flag->symbol f)
+  (or (ormap (lambda (a) (and (tag-eq? f (cadr a)) (car a))) flag-names)
+      f))
+
+(define (symbol->imap-flag s)
+  (cond [(assoc s flag-names) => cadr] [else s]))
+
+(define (log-warning . args)
+  ;; (apply printf args)
+  (void))
+(define log log-warning)
+
+(define make-msg-id
+  (let ([id 0])
+    (lambda ()
+      (begin0 (string->bytes/latin-1 (format "a~a " id))
+        (set! id (add1 id))))))
+
+(define (starts-with? l n)
+  (and (>= (bytes-length l) (bytes-length n))
+       (bytes=? n (subbytes l 0 (bytes-length n)))))
+
+(define (skip s n)
+  (subbytes s (if (number? n) n (bytes-length n))))
+
+(define (splice l sep)
+  (if (null? l)
+    ""
+    (format "~a~a"
+            (car l)
+            (apply string-append
+                   (map (lambda (n) (format "~a~a" sep n)) (cdr l))))))
+
+(define (imap-read s r)
+  (let loop ([s s]
+             [r r]
+             [accum null]
+             [eol-k (lambda (accum) (reverse accum))]
+             [eop-k (lambda (s accum) (error 'imap-read "unxpected close parenthesis"))])
+    (cond
+      [(bytes=? #"" s)
+       (eol-k accum)]
+      [(char-whitespace? (integer->char (bytes-ref s 0)))
+       (loop (skip s 1) r accum eol-k eop-k)]
+      [else
+       (case (integer->char (bytes-ref s 0))
+         [(#\")
+          (let ([m (regexp-match #rx#"\"([^\"]*)\"(.*)" s)])
+            (if m
+              (loop (caddr m) r (cons (cadr m) accum) eol-k eop-k)
+              (error 'imap-read "didn't find end of quoted string in: ~a" s)))]
+         [(#\))
+          (eop-k (skip s 1) accum)]
+         [(#\() (letrec ([next-line
+                          (lambda (accum)
+                            (loop (read-bytes-line r eol) r
+                                  accum
+                                  next-line
+                                  finish-parens))]
+                         [finish-parens
+                          (lambda (s laccum)
+                            (loop s r
+                                  (cons (reverse laccum) accum)
+                                  eol-k eop-k))])
+                  (loop (skip s 1) r null next-line finish-parens))]
+         [(#\{) (let ([m (regexp-match #rx#"{([0-9]+)}(.*)" s)])
+                  (cond
+                    [(not m) (error 'imap-read "couldn't read {} number: ~a" s)]
+                    [(not (bytes=? (caddr m) #"")) (error 'imap-read "{} not at end-of-line: ~a" s)]
+                    [else
+                     (loop #"" r
+                           (cons (read-bytes (string->number
+                                              (bytes->string/latin-1 (cadr m)))
+                                             r)
+                                 accum)
+                           eol-k eop-k)]))]
+         [else (let ([m (regexp-match #rx#"([^ (){}]+)(.*)" s)])
+                 (if m
+                   (loop (caddr m) r
+                         (cons (let ([v (cadr m)])
+                                 (if (regexp-match #rx#"^[0-9]*$" v)
+                                   (string->number (bytes->string/latin-1 v))
+                                   (string->symbol (bytes->string/latin-1 v))))
+                               accum)
+                         eol-k eop-k)
+                   (error 'imap-read "failure reading atom: ~a" s)))])])))
+
+(define (get-response r id info-handler continuation-handler)
+  (let loop ()
+    (let ([l (read-bytes-line r eol)])
+      (log "raw-reply: ~s\n" l)
+      (cond [(eof-object? l)
+             (error 'imap-send "unexpected end-of-file from server")]
+            [(and id (starts-with? l id))
+             (let ([reply (imap-read (skip l id) r)])
+               (log "response: ~a\n" reply)
+               reply)]
+            [(starts-with? l #"* ")
+             (let ([info (imap-read (skip l 2) r)])
+               (log "info: ~s\n" info)
+               (info-handler info))
+             (when id (loop))]
+            [(starts-with? l #"+ ")
+             (if (null? continuation-handler)
+               (error 'imap-send "unexpected continuation request: ~a" l)
+               ((car continuation-handler) loop (imap-read (skip l 2) r)))]
+            [else
+             (log-warning "warning: unexpected response for ~a: ~a\n" id l)
+             (when id (loop))]))))
+
+;; A cmd is
+;;  * (box v) - send v literally via ~a
+;;  * string or bytes - protect as necessary
+;;  * (cons cmd null) - same as cmd
+;;  * (cons cmd cmd) - send cmd, space, cmd
+
+(define (imap-send imap cmd info-handler . continuation-handler)
+  (let ([r (imap-r imap)]
+        [w (imap-w imap)]
+        [id (make-msg-id)])
+    (log "sending ~a~a\n" id cmd)
+    (fprintf w "~a" id)
+    (let loop ([cmd cmd])
+      (cond
+        [(box? cmd) (fprintf w "~a" (unbox cmd))]
+        [(string? cmd) (loop (string->bytes/utf-8 cmd))]
+        [(bytes? cmd)
+         (if (or (regexp-match #rx#"[ *\"\r\n]" cmd)
+                 (equal? cmd #""))
+           (if (regexp-match #rx#"[\"\r\n]" cmd)
+             (begin
+               ;; Have to send size, then continue if the
+               ;;  server consents
+               (fprintf w "{~a}\r\n" (bytes-length cmd))
+               (flush-output w)
+               (get-response r #f void (list (lambda (gloop data) (void))))
+               ;; Continue by writing the data
+               (write-bytes cmd w))
+             (fprintf w "\"~a\"" cmd))
+           (fprintf w "~a" cmd))]
+        [(and (pair? cmd) (null? (cdr cmd))) (loop (car cmd))]
+        [(pair? cmd) (begin (loop (car cmd))
+                            (fprintf w " ")
+                            (loop (cdr cmd)))]))
+    (fprintf w "\r\n")
+    (flush-output w)
+    (get-response r id (wrap-info-handler imap info-handler)
+                  continuation-handler)))
+
+(define (check-ok reply)
+  (unless (and (pair? reply) (tag-eq? (car reply) 'OK))
+    (error 'check-ok "server error: ~s" reply)))
+
+(define (ok-tag-eq? i t)
+  (and (tag-eq? (car i) 'OK)
+       ((length i) . >= . 3)
+       (tag-eq? (cadr i) (string->symbol (format "[~a" t)))))
+
+(define (ok-tag-val i)
+  (let ([v (caddr i)])
+    (and (symbol? v)
+         (let ([v (symbol->string v)])
+           (regexp-match #rx"[]]$" v)
+           (string->number (substring v 0 (sub1 (string-length v))))))))
+
+(define (wrap-info-handler imap info-handler)
+  (lambda (i)
+    (when (and (list? i) ((length i) . >= . 2))
+      (cond
+        [(tag-eq? (cadr i) 'EXISTS)
+         (when (> (car i) (or (imap-exists imap) 0))
+           (set-imap-new?! imap #t))
+         (set-imap-exists! imap (car i))]
+        [(tag-eq? (cadr i) 'RECENT)
+         (set-imap-recent! imap (car i))]
+        [(tag-eq? (cadr i) 'EXPUNGE)
+         (let ([n (car i)])
+           (log "Recording expunge: ~s\n" n)
+           ;; add it to the tree of expunges
+           (expunge-insert! (imap-expunges imap) n)
+           ;; decrement exists count:
+           (set-imap-exists! imap (sub1 (imap-exists imap)))
+           ;; adjust ids for any remembered fetches:
+           (fetch-shift! (imap-fetches imap) n))]
+        [(tag-eq? (cadr i) 'FETCH)
+         (fetch-insert!
+          (imap-fetches imap)
+          ;; Convert result to assoc list:
+          (cons (car i)
+                (let ([new
+                       (let loop ([l (caddr i)])
+                         (if (null? l)
+                           null
+                           (cons (cons (car l) (cadr l))
+                                 (loop (cddr l)))))])
+                  ;; Keep anything not overridden:
+                  (let ([old (cdr (or (fetch-find (imap-fetches imap) (car i))
+                                      '(0)))])
+                    (let loop ([old old][new new])
+                      (cond
+                        [(null? old) new]
+                        [(assq (caar old) new)
+                         (loop (cdr old) new)]
+                        [else (loop (cdr old) (cons (car old) new))]))))))]
+        [(ok-tag-eq? i 'UIDNEXT)
+         (set-imap-uidnext! imap (ok-tag-val i))]
+        [(ok-tag-eq? i 'UIDVALIDITY)
+         (set-imap-uidvalidity! imap (ok-tag-val i))]
+        [(ok-tag-eq? i 'UNSEEN)
+         (set-imap-uidvalidity! imap (ok-tag-val i))]))
+    (info-handler i)))
+
+(define imap-port-number
+  (make-parameter 143
+                  (lambda (v)
+                    (unless (and (number? v)
+                                 (exact? v)
+                                 (integer? v)
+                                 (<= 1 v 65535))
+                      (raise-type-error 'imap-port-number
+                                        "exact integer in [1,65535]"
+                                        v))
+                    v)))
+
+(define (imap-connect* r w username password inbox)
+  (with-handlers ([void
+                   (lambda (x)
+                     (close-input-port r)
+                     (close-output-port w)
+                     (raise x))])
+
+    (let ([imap (make-imap r w #f #f #f #f #f
+                           (new-tree) (new-tree) #f)])
+      (check-ok (imap-send imap "NOOP" void))
+      (let ([reply (imap-send imap (list "LOGIN" username password) void)])
+        (if (and (pair? reply) (tag-eq? 'NO (car reply)))
+          (error 'imap-connect
+                 "username or password rejected by server: ~s" reply)
+          (check-ok reply)))
+      (let-values ([(init-count init-recent) (imap-reselect imap inbox)])
+        (values imap init-count init-recent)))))
+
+(define (imap-connect server username password inbox)
+  ;; => imap count-k recent-k
+  (let-values ([(r w)
+                (if debug-via-stdio?
+                  (begin
+                    (printf "stdin == ~a\n" server)
+                    (values  (current-input-port) (current-output-port)))
+                  (tcp-connect server (imap-port-number)))])
+    (imap-connect* r w username password inbox)))
+
+(define (imap-reselect imap inbox)
+  (imap-selectish-command imap (list "SELECT" inbox) #t))
+
+(define (imap-examine imap inbox)
+  (imap-selectish-command imap (list "EXAMINE" inbox) #t))
+
+;; Used to return (values #f #f) if no change since last check?
+(define (imap-noop imap)
+  (imap-selectish-command imap "NOOP" #f))
+
+(define (imap-selectish-command imap cmd reset?)
+  (let ([init-count #f]
+        [init-recent #f])
+    (check-ok (imap-send imap cmd void))
+    (when reset?
+      (set-imap-expunges! imap (new-tree))
+      (set-imap-fetches! imap (new-tree))
+      (set-imap-new?! imap #f))
+    (values (imap-exists imap) (imap-recent imap))))
+
+(define (imap-status imap inbox flags)
+  (unless (and (list? flags)
+               (andmap (lambda (s)
+                         (memq s '(messages recent uidnext uidvalidity unseen)))
+                       flags))
+    (raise-type-error 'imap-status "list of status flag symbols" flags))
+  (let ([results null])
+    (check-ok (imap-send imap (list "STATUS" inbox (box (format "~a" flags)))
+                         (lambda (i)
+                           (when (and (list? i) (= 3 (length i))
+                                      (tag-eq? (car i) 'STATUS))
+                             (set! results (caddr i))))))
+    (map (lambda (f)
+           (let loop ([l results])
+             (cond
+               [(or (null? l) (null? (cdr l))) #f]
+               [(tag-eq? f (car l)) (cadr l)]
+               [else (loop (cdr l))])))
+         flags)))
+
+(define (imap-poll imap)
+  (when (and ;; Check for async messages from the server
+             (char-ready? (imap-r imap))
+             ;; It has better start with "*"...
+             (= (peek-byte (imap-r imap)) (char->integer #\*)))
+    ;; May set fields in `imap':
+    (get-response (imap-r imap) #f (wrap-info-handler imap void) null)
+    (void)))
+
+(define (imap-get-updates imap)
+  (no-expunges 'imap-updates imap)
+  (let ([l (fetch-tree->list (imap-fetches imap))])
+    (set-imap-fetches! imap (new-tree))
+    l))
+
+(define (imap-pending-updates? imap)
+  (not (tree-empty? (imap-fetches imap))))
+
+(define (imap-get-expunges imap)
+  (let ([l (expunge-tree->list (imap-expunges imap))])
+    (set-imap-expunges! imap (new-tree))
+    l))
+
+(define (imap-pending-expunges? imap)
+  (not (tree-empty? (imap-expunges imap))))
+
+(define (imap-reset-new! imap)
+  (set-imap-new?! imap #f))
+
+(define (imap-messages imap)
+  (imap-exists imap))
+
+(define (imap-disconnect imap)
+  (let ([r (imap-r imap)]
+        [w (imap-w imap)])
+    (check-ok (imap-send imap "LOGOUT" void))
+    (close-input-port r)
+    (close-output-port w)))
+
+(define (imap-force-disconnect imap)
+  (let ([r (imap-r imap)]
+        [w (imap-w imap)])
+    (close-input-port r)
+    (close-output-port w)))
+
+(define (no-expunges who imap)
+  (unless (tree-empty? (imap-expunges imap))
+    (raise-mismatch-error who "session has pending expunge reports: " imap)))
+
+(define (msg-set msgs)
+  (apply
+   string-append
+   (let loop ([prev #f][msgs msgs])
+     (cond
+       [(null? msgs) null]
+       [(and prev
+             (pair? (cdr msgs))
+             (= (add1 prev) (car msgs)))
+        (loop (car msgs) (cdr msgs))]
+       [prev (cons (format ":~a," prev)
+                   (loop #f msgs))]
+       [(null? (cdr msgs)) (list (format "~a" (car msgs)))]
+       [(= (add1 (car msgs)) (cadr msgs))
+        (cons (format "~a" (car msgs))
+              (loop (car msgs) (cdr msgs)))]
+       [else (cons (format "~a," (car msgs))
+                   (loop #f (cdr msgs)))]))))
+
+(define (imap-get-messages imap msgs field-list)
+  (no-expunges 'imap-get-messages imap)
+  (when (or (not (list? msgs))
+            (not (andmap integer? msgs)))
+    (raise-type-error 'imap-get-messages "non-empty message list" msgs))
+  (when (or (null? field-list)
+            (not (list? field-list))
+            (not (andmap (lambda (f) (assoc f field-names)) field-list)))
+    (raise-type-error 'imap-get-messages "non-empty field list" field-list))
+
+  (if (null? msgs)
+    null
+    (begin
+      ;; FETCH request adds info to `(imap-fectches imap)':
+      (imap-send imap
+                 (list "FETCH"
+                       (box (msg-set msgs))
+                       (box
+                        (format "(~a)"
+                                (splice (map (lambda (f)
+                                               (cadr (assoc f field-names)))
+                                             field-list)
+                                        " "))))
+                 void)
+      ;; Sort out the collected info:
+      (let ([flds (map (lambda (f) (cadr (assoc f field-names)))
+                       field-list)])
+        (begin0
+            ;; For each msg, try to get each field value:
+            (map
+             (lambda (msg)
+               (let ([m (or (fetch-find (imap-fetches imap) msg)
+                            (error 'imap-get-messages "no result for message ~a" msg))])
+                 (let loop ([flds flds][m (cdr m)])
+                   (cond
+                     [(null? flds)
+                      (if (null? m)
+                        (fetch-delete! (imap-fetches imap) msg)
+                        (fetch-insert! (imap-fetches imap) (cons msg m)))
+                      null]
+                     [else
+                      (let ([a (assoc (car flds) m)])
+                        (cons (and a (cdr a))
+                              (loop (cdr flds) (if a (remq a m) m))))]))))
+             msgs))))))
+
+(define (imap-store imap mode msgs flags)
+  (no-expunges 'imap-store imap)
+  (check-ok
+   (imap-send imap
+              (list "STORE"
+                    (box (msg-set msgs))
+                    (case mode
+                      [(+) "+FLAGS.SILENT"]
+                      [(-) "-FLAGS.SILENT"]
+                      [(!) "FLAGS.SILENT"]
+                      [else (raise-type-error 'imap-store
+                                              "mode: '!, '+, or '-" mode)])
+                    (box (format "~a" flags)))
+              void)))
+
+(define (imap-copy imap msgs dest-mailbox)
+  (no-expunges 'imap-copy imap)
+  (check-ok
+   (imap-send imap (list "COPY" (box (msg-set msgs)) dest-mailbox) void)))
+
+(define (imap-append imap dest-mailbox msg)
+  (no-expunges 'imap-append imap)
+  (let ([msg (if (bytes? msg) msg (string->bytes/utf-8 msg))])
+    (check-ok
+     (imap-send imap (list "APPEND"
+                           dest-mailbox
+                           (box "(\\Seen)")
+                           (box (format "{~a}" (bytes-length msg))))
+                void
+                (lambda (loop contin)
+                  (fprintf (imap-w imap) "~a\r\n" msg)
+                  (loop))))))
+
+(define (imap-expunge imap)
+  (check-ok (imap-send imap "EXPUNGE" void)))
+
+(define (imap-mailbox-exists? imap mailbox)
+  (let ([exists? #f])
+    (check-ok (imap-send imap
+                         (list "LIST" "" mailbox)
+                         (lambda (i)
+                           (when (and (pair? i) (tag-eq? (car i) 'LIST))
+                             (set! exists? #t)))))
+    exists?))
+
+(define (imap-create-mailbox imap mailbox)
+  (check-ok (imap-send imap (list "CREATE" mailbox) void)))
+
+(define (imap-get-hierarchy-delimiter imap)
+  (let ([result #f])
+    (check-ok
+     (imap-send imap (list "LIST" "" "")
+                (lambda (i)
+                  (when (and (pair? i) (tag-eq? (car i) 'LIST))
+                    (set! result (caddr i))))))
+    result))
+
+(define imap-list-child-mailboxes
+  (case-lambda
+    [(imap mailbox)
+     (imap-list-child-mailboxes imap mailbox #f)]
+    [(imap mailbox raw-delimiter)
+     (let* ([delimiter (or raw-delimiter (imap-get-hierarchy-delimiter imap))]
+            [mailbox-name (and mailbox (bytes-append mailbox delimiter))]
+            [pattern (if mailbox
+                       (bytes-append mailbox-name #"%")
+                       #"%")])
+       (map (lambda (p)
+              (list (car p)
+                    (cond
+                      [(symbol? (cadr p))
+                       (string->bytes/utf-8 (symbol->string (cadr p)))]
+                      [(string? (cadr p))
+                       (string->bytes/utf-8 (symbol->string (cadr p)))]
+                      [(bytes? (cadr p))
+                       (cadr p)])))
+            (imap-list-mailboxes imap pattern mailbox-name)))]))
+
+(define (imap-mailbox-flags imap mailbox)
+  (let ([r (imap-list-mailboxes imap mailbox #f)])
+    (if (= (length r) 1)
+      (caar r)
+      (error 'imap-mailbox-flags "could not get flags for ~s (~a)"
+             mailbox
+             (if (null? r) "no matches" "multiple matches")))))
+
+(define (imap-list-mailboxes imap pattern except)
+  (let* ([sub-folders null])
+    (check-ok
+     (imap-send imap (list "LIST" "" pattern)
+                (lambda (x)
+                  (when (and (pair? x)
+                             (tag-eq? (car x) 'LIST))
+                    (let* ([flags (cadr x)]
+                           [name (cadddr x)]
+                           [bytes-name (if (symbol? name)
+                                         (string->bytes/utf-8 (symbol->string name))
+                                         name)])
+                      (unless (and except
+                                   (bytes=? bytes-name except))
+                        (set! sub-folders
+                              (cons (list flags name) sub-folders))))))))
+    (reverse sub-folders)))
diff --git a/collects/net/mime-unit.rkt b/collects/net/mime-unit.rkt
index fee2e9f890..538eab9236 100644
--- a/collects/net/mime-unit.rkt
+++ b/collects/net/mime-unit.rkt
@@ -1,734 +1,8 @@
-;;;
-;;; <mime-unit.rkt> ---- MIME support
-;;;
-;;; Copyright (C) 2002 by PLT.
-;;; Copyright (C) 2001 by Wish Computing.
-;;;
-;;; This file is part of mime
+#lang racket/base
 
-;;; mime-plt is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
+(require racket/unit
+         "mime-sig.rkt" "mime.rkt")
 
-;;; mime-plt is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
+(define-unit-from-context mime@ mime^)
 
-;;; You should have received a copy of the GNU General Public License
-;;; along with mime-plt; see the file COPYING.  If not, write to the
-;;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA.
-
-;;; Author: Francisco Solsona <solsona@acm.org>
-;;
-;;
-;; Commentary: MIME support for PLT Scheme: an implementation of
-;; rfc2045, rfc2046, rfc2047, rfc2048, and rfc2049.
-
-#lang racket/unit
-
-(require "mime-sig.rkt" "qp-sig.rkt" "base64-sig.rkt" "head-sig.rkt"
-         "mime-util.rkt"
-         racket/port)
-
-(import base64^ qp^ head^)
-(export mime^)
-
-;; Constants:
-(define discrete-alist
-  '(("text" . text)
-    ("image" . image)
-    ("audio" . audio)
-    ("video" . video)
-    ("application" . application)))
-
-(define disposition-alist
-  '(("inline" . inline)
-    ("attachment" . attachment)
-    ("file" . attachment) ;; This is used (don't know why) by
-                          ;; multipart/form-data
-    ("messagetext" . inline)
-    ("form-data" . form-data)))
-
-(define composite-alist
-  '(("message" . message)
-    ("multipart" . multipart)))
-
-(define mechanism-alist
-  '(("7bit" . 7bit)
-    ("8bit" . 8bit)
-    ("binary" . binary)
-    ("quoted-printable" . quoted-printable)
-    ("base64" . base64)))
-
-(define ietf-extensions '())
-(define iana-extensions
-  '(;; text
-    ("plain" . plain)
-    ("html" . html)
-    ("enriched"  . enriched) ; added 5/2005 - probably not iana
-    ("richtext"  . richtext)
-    ("tab-separated-values" . tab-separated-values)
-    ;; Multipart
-    ("mixed" . mixed)
-    ("alternative" . alternative)
-    ("digest" . digest)
-    ("parallel" . parallel)
-    ("appledouble" . appledouble)
-    ("header-set" . header-set)
-    ("form-data" . form-data)
-    ;; Message
-    ("rfc822" . rfc822)
-    ("partial" . partial)
-    ("external-body" . external-body)
-    ("news" . news)
-    ;; Application
-    ("octet-stream" . octet-stream)
-    ("postscript" . postscript)
-    ("oda" . oda)
-    ("atomicmail" . atomicmail)
-    ("andrew-inset" . andrew-inset)
-    ("slate" . slate)
-    ("wita" . wita)
-    ("dec-dx" . dec-dx)
-    ("dca-rf" . dca-rf)
-    ("activemessage" . activemessage)
-    ("rtf" . rtf)
-    ("applefile" . applefile)
-    ("mac-binhex40" . mac-binhex40)
-    ("news-message-id" . news-message-id)
-    ("news-transmissio" . news-transmissio)
-    ("wordperfect5.1" . wordperfect5.1)
-    ("pdf" . pdf)
-    ("zip" . zip)
-    ("macwritei" . macwritei)
-    ;; "image"
-    ("jpeg" . jpeg)
-    ("gif" . gif)
-    ("ief" . ief)
-    ("tiff" . tiff)
-    ;; "audio"
-    ("basic" . basic)
-    ;; "video" .
-    ("mpeg" . mpeg)
-    ("quicktime" . quicktime)))
-
-;; Basic structures
-(define-struct message (version entity fields)
-  #:mutable)
-(define-struct entity
-  (type subtype charset encoding disposition params id description other
-   fields parts body) 
-  #:mutable)
-(define-struct disposition
-  (type filename creation modification read size params)
-  #:mutable)
-
-;; Exceptions
-(define-struct mime-error ())
-(define-struct (unexpected-termination mime-error) (msg))
-(define-struct (missing-multipart-boundary-parameter mime-error) ())
-(define-struct (malformed-multipart-entity mime-error) (msg))
-(define-struct (empty-mechanism mime-error) ())
-(define-struct (empty-type mime-error) ())
-(define-struct (empty-subtype mime-error) ())
-(define-struct (empty-disposition-type mime-error) ())
-
-;; *************************************
-;; Practical stuff, aka MIME in action:
-;; *************************************
-(define CRLF (format "~a~a" #\return #\newline))
-(define CRLF-binary "=0D=0A") ;; quoted printable representation
-
-;; get-headers : input-port -> string
-;; returns the header part of a message/part conforming to rfc822, and
-;; rfc2045.
-(define (get-headers in)
-  (let loop ([headers ""] [ln (read-line in 'any)])
-    (cond [(eof-object? ln)
-           ;; (raise (make-unexpected-termination "eof reached! while parsing headers"))
-           (warning "premature eof while parsing headers")
-           headers]
-          [(string=? ln "") headers]
-          [else
-           ;; Quoting rfc822:
-           ;; " Headers occur before the message body and are
-           ;; terminated by a null line (i.e., two contiguous
-           ;; CRLFs)."
-           ;; That is: Two empty lines.  But most MUAs seem to count
-           ;; the CRLF ending the last field (header) as the first
-           ;; CRLF of the null line.
-           (loop (string-append headers ln CRLF)
-                 (read-line in 'any))])))
-
-(define (make-default-disposition)
-  (make-disposition
-   'inline ;; type
-   "" ;; filename
-   #f ;; creation
-   #f ;; modification
-   #f ;; read
-   #f ;; size
-   null ;; params
-   ))
-
-(define (make-default-entity)
-  (make-entity
-   'text  ;; type
-   'plain ;; subtype
-   'us-ascii ;; charset
-   '7bit  ;; encoding
-   (make-default-disposition) ;; disposition
-   null   ;; params
-   ""     ;; id
-   ""     ;; description
-   null   ;; other MIME fields (MIME-extension-fields)
-   null   ;; fields
-   null   ;; parts
-   null   ;; body
-   ))
-
-(define (make-default-message)
-  (make-message 1.0 (make-default-entity) null))
-
-(define (mime-decode entity input)
-  (set-entity-body!
-   entity
-   (case (entity-encoding entity)
-     [(quoted-printable)
-      (lambda (output)
-        (qp-decode-stream input output))]
-     [(base64)
-      (lambda (output)
-        (base64-decode-stream input output))]
-     [else ;; 7bit, 8bit, binary
-      (lambda (output)
-        (copy-port input output))])))
-
-(define (mime-analyze input [part #f])
-  (let* ([iport (if (bytes? input)
-                  (open-input-bytes input)
-                  input)]
-         [headers (get-headers iport)]
-         [msg (if part
-                (MIME-part-headers headers)
-                (MIME-message-headers headers))]
-         [entity (message-entity msg)])
-    ;; OK we have in msg a MIME-message structure, lets see what we have:
-    (case (entity-type entity)
-      [(text image audio video application)
-       ;; decode part, and save port and thunk
-       (mime-decode entity iport)]
-      [(message multipart)
-       (let ([boundary (entity-boundary entity)])
-         (when (not boundary)
-           (when (eq? 'multipart (entity-type entity))
-             (raise (make-missing-multipart-boundary-parameter))))
-         (set-entity-parts! entity
-                            (map (lambda (part)
-                                   (mime-analyze part #t))
-                                 (if boundary
-                                   (multipart-body iport boundary)
-                                   (list iport)))))]
-      [else
-       ;; Unrecognized type, you're on your own! (sorry)
-       (mime-decode entity iport)])
-    ;; return mime structure
-    msg))
-
-(define (entity-boundary entity)
-  (let* ([params (entity-params entity)]
-         [ans (assoc "boundary" params)])
-    (and ans (cdr ans))))
-
-;; *************************************************
-;; MIME Specific: rfc2045-2049, and rfc0822, rfc2183
-;; *************************************************
-
-;;multipart-body := [preamble CRLF]
-;;                  dash-boundary transport-padding CRLF
-;;                  body-part *encapsulation
-;;                  close-delimiter transport-padding
-;;                  [CRLF epilogue]
-;; Returns a list of input ports, each one containing the correspongind part.
-(define (multipart-body input boundary)
-  (let* ([make-re (lambda (prefix)
-                    (regexp (string-append prefix "--" (regexp-quote boundary) "(--)?\r\n")))]
-         [re (make-re "\r\n")])
-    (letrec ([eat-part (lambda ()
-                         (let-values ([(pin pout) (make-pipe)])
-                           (let ([m (regexp-match re input 0 #f pout)])
-                             (cond
-                               [(not m)
-                                (close-output-port pout)
-                                (values pin ;; part
-                                        #f  ;; close-delimiter?
-                                        #t  ;; eof reached?
-                                        )]
-                               [(cadr m)
-                                (close-output-port pout)
-                                (values pin #t #f)]
-                               [else
-                                (close-output-port pout)
-                                (values pin #f #f)]))))])
-      ;; pre-amble is allowed to be completely empty:
-      (if (regexp-match-peek (make-re "^") input)
-        ;; No \r\f before first separator:
-        (read-line input)
-        ;; non-empty preamble:
-        (eat-part))
-      (let loop ()
-        (let-values ([(part close? eof?) (eat-part)])
-          (cond [close? (list part)]
-                [eof? (list part)]
-                [else (cons part (loop))]))))))
-
-;; MIME-message-headers := entity-headers
-;;                        fields
-;;                        version CRLF
-;;                        ; The ordering of the header
-;;                        ; fields implied by this BNF
-;;                        ; definition should be ignored.
-(define (MIME-message-headers headers)
-  (let ([message (make-default-message)])
-    (entity-headers headers message #t)
-    message))
-
-;; MIME-part-headers := entity-headers
-;;                     [ fields ]
-;;                     ; Any field not beginning with
-;;                     ; "content-" can have no defined
-;;                     ; meaning and may be ignored.
-;;                     ; The ordering of the header
-;;                     ; fields implied by this BNF
-;;                     ; definition should be ignored.
-(define (MIME-part-headers headers)
-  (let ([message (make-default-message)])
-    (entity-headers headers message #f)
-    message))
-
-;; entity-headers := [ content CRLF ]
-;;                  [ encoding CRLF ]
-;;                  [ id CRLF ]
-;;                  [ description CRLF ]
-;;                  *( MIME-extension-field CRLF )
-(define (entity-headers headers message version?)
-  (let ([entity (message-entity message)])
-    (let-values ([(mime non-mime) (get-fields headers)])
-      (let loop ([fields mime])
-        (unless (null? fields)
-          ;; Process MIME field
-          (let ([trimmed-h (trim-comments (car fields))])
-            (or (and version? (version trimmed-h message))
-                (content trimmed-h entity)
-                (encoding trimmed-h entity)
-                (dispositione trimmed-h entity)
-                (id trimmed-h entity)
-                (description trimmed-h entity)
-                (MIME-extension-field trimmed-h entity))
-            ;; keep going
-            (loop (cdr fields)))))
-      ;; NON-mime headers (or semantically incorrect). In order to make
-      ;; this implementation of rfc2045 robuts, we will save the header in
-      ;; the fields field of the message struct:
-      (set-message-fields! message non-mime)
-      ;; Return message
-      message)))
-
-(define (get-fields headers)
-  (let ([mime null] [non-mime null])
-    (letrec ([store-field
-              (lambda (f)
-                (unless (string=? f "")
-                  (if (mime-header? f)
-                    (set! mime (append mime (list (trim-spaces f))))
-                    (set! non-mime (append non-mime (list (trim-spaces f)))))))])
-      (let ([fields (extract-all-fields headers)])
-        (for-each (lambda (p)
-                    (store-field (format "~a: ~a" (car p) (cdr p))))
-                  fields))
-      (values mime non-mime))))
-
-(define re:content #rx"^(?i:content-)")
-(define re:mime #rx"^(?i:mime-version):")
-
-(define (mime-header? h)
-  (or (regexp-match? re:content h)
-      (regexp-match? re:mime h)))
-
-;;; Headers
-;;; Content-type follows this BNF syntax:
-;; content := "Content-Type" ":" type "/" subtype
-;;           *(";" parameter)
-;;           ; Matching of media type and subtype
-;;           ; is ALWAYS case-insensitive.
-(define re:content-type #rx"^(?i:content-type):([^/]+)/([^/]+)$")
-(define (content header entity)
-  (let* ([params (string-tokenizer #\; header)]
-         [one re:content-type]
-         [h (trim-all-spaces (car params))]
-         [target (regexp-match one h)]
-         [old-param (entity-params entity)])
-    (and target
-         (set-entity-type! entity
-                           (type (regexp-replace one h "\\1")))   ;; type
-         (set-entity-subtype! entity
-                              (subtype (regexp-replace one h "\\2"))) ;; subtype
-         (set-entity-params!
-          entity
-          (append old-param
-                  (let loop ([p (cdr params)] ;; parameters
-                             [ans null])
-                    (cond [(null? p) ans]
-                          [else
-                           (let ([par-pair (parameter (trim-all-spaces (car p)))])
-                             (cond [par-pair
-                                    (when (string=? (car par-pair) "charset")
-                                      (set-entity-charset! entity (cdr par-pair)))
-                                    (loop (cdr p) (append ans (list par-pair)))]
-                                   [else
-                                    (warning "Invalid parameter for Content-Type: `~a'" (car p))
-                                    ;; go on...
-                                    (loop (cdr p) ans)]))])))))))
-
-;; From rfc2183 Content-Disposition
-;; disposition := "Content-Disposition" ":"
-;;                  disposition-type
-;;                  *(";" disposition-parm)
-(define re:content-disposition #rx"^(?i:content-disposition):(.+)$")
-(define (dispositione header entity)
-  (let* ([params (string-tokenizer #\; header)]
-         [reg re:content-disposition]
-         [h (trim-all-spaces (car params))]
-         [target (regexp-match reg h)]
-         [disp-struct (entity-disposition entity)])
-    (and target
-         (set-disposition-type!
-          disp-struct
-          (disp-type (regexp-replace reg h "\\1")))
-         (disp-params (cdr params) disp-struct))))
-
-;; version := "MIME-Version" ":" 1*DIGIT "." 1*DIGIT
-(define re:mime-version #rx"^(?i:MIME-Version):([0-9]+)\\.([0-9]+)$")
-(define (version header message)
-  (let* ([reg re:mime-version]
-         [h (trim-all-spaces header)]
-         [target (regexp-match reg h)])
-    (and target
-         (set-message-version!
-          message
-          (string->number (regexp-replace reg h "\\1.\\2"))))))
-
-;;   description := "Content-Description" ":" *text
-(define re:content-description #rx"^(?i:content-description):[ \t\r\n]*(.*)$")
-(define (description header entity)
-  (let* ([reg re:content-description]
-         [target (regexp-match reg header)])
-    (and target
-         (set-entity-description!
-          entity
-          (trim-spaces (regexp-replace reg header "\\1"))))))
-
-;;   encoding := "Content-Transfer-Encoding" ":" mechanism
-(define re:content-transfer-encoding #rx"^(?i:content-transfer-encoding):(.+)$")
-(define (encoding header entity)
-  (let* ([reg re:content-transfer-encoding]
-         [h (trim-all-spaces header)]
-         [target (regexp-match reg h)])
-    (and target
-         (set-entity-encoding!
-          entity
-          (mechanism (regexp-replace reg h "\\1"))))))
-
-;;   id := "Content-ID" ":" msg-id
-(define re:content-id #rx"^(?i:content-id):(.+)$")
-(define (id header entity)
-  (let* ([reg re:content-id]
-         [h (trim-all-spaces header)]
-         [target (regexp-match reg h)])
-    (and target
-         (set-entity-id!
-          entity
-          (msg-id (regexp-replace reg h "\\1"))))))
-
-;; From rfc822:
-;; msg-id      =  "<" addr-spec ">"            ; Unique message id
-;; addr-spec   =  local-part "@" domain        ; global address
-;; local-part  =  word *("." word)             ; uninterpreted
-;;                                             ; case-preserved
-;; domain      =  sub-domain *("." sub-domain)
-;; sub-domain  =  domain-ref / domain-literal
-;; domain-literal =  "[" *(dtext / quoted-pair) "]"
-;; domain-ref  =  atom                         ; symbolic reference
-(define (msg-id str)
-  (let* ([r (regexp "^<[^@>]+@[^.]+(\\.[^.]+)*>$")]
-         [ans (regexp-match r str)])
-    (if ans
-      str
-      (begin (warning "Invalid msg-id: ~a" str) str))))
-
-;;  mechanism := "7bit" / "8bit" / "binary" /
-;;                 "quoted-printable" / "base64" /
-;;                 ietf-token / x-token
-(define (mechanism mech)
-  (if (not mech)
-    (raise (make-empty-mechanism))
-    (let ([val (assoc (lowercase mech) mechanism-alist)])
-      (or (and val (cdr val))
-          (ietf-token mech)
-          (x-token mech)))))
-
-;;  MIME-extension-field := <Any RFC 822 header field which
-;;                              begins with the string
-;;                              "Content-">
-;;
-(define (MIME-extension-field header entity)
-  (let* ([reg (regexp "^[Cc]ontent-(.+):[ \t]*(.+)$")]
-         [target (regexp-match reg header)])
-    (and target
-         (set-entity-other!
-          entity
-          (append (entity-other entity)
-                  (list (cons (regexp-replace reg header "\\1")
-                              (trim-spaces (regexp-replace reg header "\\2")))))))))
-
-;; type := discrete-type / composite-type
-(define (type value)
-  (if (not value)
-    (raise (make-empty-type))
-    (or (discrete-type value)
-        (composite-type value))))
-
-;; disposition-type := "inline" / "attachment"  / extension-token
-(define (disp-type value)
-  (if (not value)
-    (raise (make-empty-disposition-type))
-    (let ([val (assoc (lowercase (trim-spaces value)) disposition-alist)])
-      (if val (cdr val) (extension-token value)))))
-
-;; discrete-type := "text" / "image" / "audio" / "video" /
-;;                  "application" / extension-token
-(define (discrete-type value)
-  (let ([val (assoc (lowercase (trim-spaces value)) discrete-alist)])
-    (if val (cdr val) (extension-token value))))
-
-;; composite-type := "message" / "multipart" / extension-token
-(define (composite-type value)
-  (let ([val (assoc (lowercase (trim-spaces value)) composite-alist)])
-    (if val (cdr val) (extension-token value))))
-
-;; extension-token := ietf-token / x-token
-(define (extension-token value)
-  (or (ietf-token value)
-      (x-token value)))
-
-;; ietf-token := <An extension token defined by a
-;;               standards-track RFC and registered
-;;               with IANA.>
-(define (ietf-token value)
-  (let ([ans (assoc (lowercase (trim-spaces value)) ietf-extensions)])
-    (and ans (cdr ans))))
-
-;;  Directly from RFC 1700:
-;; Type            Subtype         Description                 Reference
-;; ----            -------         -----------                 ---------
-;; text            plain                                   [RFC1521,NSB]
-;;                 richtext                                [RFC1521,NSB]
-;;                 tab-separated-values                   [Paul Lindner]
-;;
-;; multipart       mixed                                   [RFC1521,NSB]
-;;                 alternative                             [RFC1521,NSB]
-;;                 digest                                  [RFC1521,NSB]
-;;                 parallel                                [RFC1521,NSB]
-;;                 appledouble                [MacMime,Patrik Faltstrom]
-;;                 header-set                             [Dave Crocker]
-;;
-;; message         rfc822                                  [RFC1521,NSB]
-;;                 partial                                 [RFC1521,NSB]
-;;                 external-body                           [RFC1521,NSB]
-;;                 news                        [RFC 1036, Henry Spencer]
-;;
-;; application     octet-stream                            [RFC1521,NSB]
-;;                   postscript                              [RFC1521,NSB]
-;;                   oda                                     [RFC1521,NSB]
-;;                   atomicmail                           [atomicmail,NSB]
-;;                   andrew-inset                       [andrew-inset,NSB]
-;;                   slate                           [slate,terry crowley]
-;;                   wita              [Wang Info Transfer,Larry Campbell]
-;;                   dec-dx            [Digital Doc Trans, Larry Campbell]
-;;                   dca-rft        [IBM Doc Content Arch, Larry Campbell]
-;;                   activemessage                          [Ehud Shapiro]
-;;                   rtf                                    [Paul Lindner]
-;;                   applefile                  [MacMime,Patrik Faltstrom]
-;;                   mac-binhex40               [MacMime,Patrik Faltstrom]
-;;                   news-message-id              [RFC1036, Henry Spencer]
-;;                   news-transmission            [RFC1036, Henry Spencer]
-;;                   wordperfect5.1                         [Paul Lindner]
-;;                   pdf                                    [Paul Lindner]
-;;                   zip                                    [Paul Lindner]
-;;                   macwriteii                             [Paul Lindner]
-;;                   msword                                 [Paul Lindner]
-;;                   remote-printing                         [RFC1486,MTR]
-;;
-;; image           jpeg                                    [RFC1521,NSB]
-;;                 gif                                     [RFC1521,NSB]
-;;                 ief             Image Exchange Format       [RFC1314]
-;;                 tiff            Tag Image File Format           [MTR]
-;;
-;; audio           basic                                   [RFC1521,NSB]
-;;
-;; video           mpeg                                    [RFC1521,NSB]
-;;                 quicktime                              [Paul Lindner]
-
-;; x-token := <The two characters "X-" or "x-" followed, with
-;;            no intervening white space, by any token>
-(define (x-token value)
-  (let* ([r  #rx"^[xX]-(.*)"]
-         [h (trim-spaces value)]
-         [ans (regexp-match r h)])
-    (and ans
-         (token (regexp-replace r h "\\1"))
-         h)))
-
-;; subtype := extension-token / iana-token
-(define (subtype value)
-  (if (not value)
-    (raise (make-empty-subtype))
-    (or (extension-token value)
-        (iana-token value))))
-
-;; iana-token := <A publicly-defined extension token. Tokens
-;;               of this form must be registered with IANA
-;;               as specified in RFC 2048.>
-(define (iana-token value)
-  (let ([ans (assoc (lowercase (trim-spaces value)) iana-extensions)])
-    (and ans (cdr ans))))
-
-;; parameter := attribute "=" value
-(define re:parameter (regexp "([^=]+)=(.+)"))
-(define (parameter par)
-  (let* ([r re:parameter]
-         [att (attribute (regexp-replace r par "\\1"))]
-         [val (value (regexp-replace r par "\\2"))])
-    (if (regexp-match r par)
-      (cons (if att (lowercase att) "???") val)
-      (cons "???" par))))
-
-;; value := token / quoted-string
-(define (value val)
-  (or (token val)
-      (quoted-string val)
-      val))
-
-;; token := 1*<any (US-ASCII) CHAR except SPACE, CTLs,
-;;            or tspecials>
-;; tspecials :=  "(" / ")" / "<" / ">" / "@" /
-;;              "," / ";" / ":" / "\" / <">
-;;              "/" / "[" / "]" / "?" / "="
-;;              ; Must be in quoted-string,
-;;              ; to use within parameter values
-(define (token value)
-  (let* ([tspecials (regexp "[^][()<>@,;:\\\"/?= ]+")]
-         [ans (regexp-match tspecials value)])
-    (and ans
-         (string=? value (car ans))
-         (car ans))))
-
-;; attribute := token
-;;             ; Matching of attributes
-;;             ; is ALWAYS case-insensitive.
-(define attribute token)
-
-(define re:quotes (regexp "\"(.+)\""))
-(define (quoted-string str)
-  (let* ([quotes re:quotes]
-         [ans (regexp-match quotes str)])
-    (and ans (regexp-replace quotes str "\\1"))))
-
-;; disposition-parm := filename-parm
-;;                     / creation-date-parm
-;;                     / modification-date-parm
-;;                     / read-date-parm
-;;                     / size-parm
-;;                     / parameter
-;;
-;; filename-parm := "filename" "=" value
-;;
-;; creation-date-parm := "creation-date" "=" quoted-date-time
-;;
-;; modification-date-parm := "modification-date" "=" quoted-date-time
-;;
-;; read-date-parm := "read-date" "=" quoted-date-time
-;;
-;; size-parm := "size" "=" 1*DIGIT
-(define (disp-params lst disp)
-  (let loop ([lst lst])
-    (unless (null? lst)
-      (let* ([p (parameter (trim-all-spaces (car lst)))]
-             [parm (car p)]
-             [value (cdr p)])
-        (cond [(string=? parm "filename")
-               (set-disposition-filename! disp value)]
-              [(string=? parm "creation-date")
-               (set-disposition-creation!
-                disp
-                (disp-quoted-data-time value))]
-              [(string=? parm "modification-date")
-               (set-disposition-modification!
-                disp
-                (disp-quoted-data-time value))]
-              [(string=? parm "read-date")
-               (set-disposition-read!
-                disp
-                (disp-quoted-data-time value))]
-              [(string=? parm "size")
-               (set-disposition-size!
-                disp
-                (string->number value))]
-              [else
-               (set-disposition-params!
-                disp
-                (append (disposition-params disp) (list p)))])
-        (loop (cdr lst))))))
-
-;; date-time   =  [ day "," ] date time        ; dd mm yy
-;;                                             ;  hh:mm:ss zzz
-;;
-;; day         =  "Mon"  / "Tue" /  "Wed"  / "Thu"
-;;            /  "Fri"  / "Sat" /  "Sun"
-;;
-;; date        =  1*2DIGIT month 2DIGIT        ; day month year
-;;                                   ;  e.g. 20 Jun 82
-;;
-;; month       =  "Jan"  /  "Feb" /  "Mar"  /  "Apr"
-;;            /  "May"  /  "Jun" /  "Jul"  /  "Aug"
-;;            /  "Sep"  /  "Oct" /  "Nov"  /  "Dec"
-;;
-;; time        =  hour zone                    ; ANSI and Military
-;;
-;; hour        =  2DIGIT ":" 2DIGIT [":" 2DIGIT]
-;;                                   ; 00:00:00 - 23:59:59
-;;
-;; zone        =  "UT"  / "GMT"                ; Universal Time
-;;                                   ; North American : UT
-;;            /  "EST" / "EDT"                ;  Eastern:  - 5/ - 4
-;;            /  "CST" / "CDT"                ;  Central:  - 6/ - 5
-;;            /  "MST" / "MDT"                ;  Mountain: - 7/ - 6
-;;            /  "PST" / "PDT"                ;  Pacific:  - 8/ - 7
-;;            /  1ALPHA                       ; Military: Z = UT;
-;;                                   ;  A:-1; (J not used)
-;;                                   ;  M:-12; N:+1; Y:+12
-;;            / ( ("+" / "-") 4DIGIT )        ; Local differential
-;;                                   ;  hours+min. (HHMM)
-(define date-time
-  (lambda (str)
-    ;; Fix Me: I have to return a date structure, or time in seconds.
-    str))
-
-;; quoted-date-time := quoted-string
-;;                ; contents MUST be an RFC 822 `date-time'
-;;                ; numeric timezones (+HHMM or -HHMM) MUST be used
-
-(define disp-quoted-data-time date-time)
+(provide mime@)
diff --git a/collects/net/mime.rkt b/collects/net/mime.rkt
index 9714637433..508a656597 100644
--- a/collects/net/mime.rkt
+++ b/collects/net/mime.rkt
@@ -23,21 +23,725 @@
 
 ;;; Author: Francisco Solsona <solsona@acm.org>
 ;;
-;;
-;; Commentary:
+;; Commentary: MIME support for PLT Scheme: an implementation of
+;; rfc2045, rfc2046, rfc2047, rfc2048, and rfc2049.
 
 #lang racket/base
-(require racket/unit
-         "mime-sig.rkt" "mime-unit.rkt" "qp.rkt" "base64.rkt" "head.rkt")
 
-;(define-unit-from-context base64@ base64^)
-;(define-unit-from-context qp@ qp^)
-;(define-unit-from-context head@ head^)
+(require racket/port "mime-util.rkt" "qp.rkt" "base64.rkt" "head.rkt")
 
-(define-values/invoke-unit/infer 
-  (export mime^)
-  (link mime@))
+(provide
+ ;; -- exceptions raised --
+ (struct-out mime-error)
+ (struct-out unexpected-termination)
+ (struct-out missing-multipart-boundary-parameter)
+ (struct-out malformed-multipart-entity)
+ (struct-out empty-mechanism)
+ (struct-out empty-type)
+ (struct-out empty-subtype)
+ (struct-out empty-disposition-type)
 
-(provide-signature-elements mime^)
+ ;; -- basic mime structures --
+ (struct-out message)
+ (struct-out entity)
+ (struct-out disposition)
 
-;;; mime.rkt ends here
+ ;; -- mime methods --
+ mime-analyze)
+
+;; Constants:
+(define discrete-alist
+  '(("text" . text)
+    ("image" . image)
+    ("audio" . audio)
+    ("video" . video)
+    ("application" . application)))
+
+(define disposition-alist
+  '(("inline" . inline)
+    ("attachment" . attachment)
+    ("file" . attachment) ;; This is used (don't know why) by
+                          ;; multipart/form-data
+    ("messagetext" . inline)
+    ("form-data" . form-data)))
+
+(define composite-alist
+  '(("message" . message)
+    ("multipart" . multipart)))
+
+(define mechanism-alist
+  '(("7bit" . 7bit)
+    ("8bit" . 8bit)
+    ("binary" . binary)
+    ("quoted-printable" . quoted-printable)
+    ("base64" . base64)))
+
+(define ietf-extensions '())
+(define iana-extensions
+  '(;; text
+    ("plain" . plain)
+    ("html" . html)
+    ("enriched"  . enriched) ; added 5/2005 - probably not iana
+    ("richtext"  . richtext)
+    ("tab-separated-values" . tab-separated-values)
+    ;; Multipart
+    ("mixed" . mixed)
+    ("alternative" . alternative)
+    ("digest" . digest)
+    ("parallel" . parallel)
+    ("appledouble" . appledouble)
+    ("header-set" . header-set)
+    ("form-data" . form-data)
+    ;; Message
+    ("rfc822" . rfc822)
+    ("partial" . partial)
+    ("external-body" . external-body)
+    ("news" . news)
+    ;; Application
+    ("octet-stream" . octet-stream)
+    ("postscript" . postscript)
+    ("oda" . oda)
+    ("atomicmail" . atomicmail)
+    ("andrew-inset" . andrew-inset)
+    ("slate" . slate)
+    ("wita" . wita)
+    ("dec-dx" . dec-dx)
+    ("dca-rf" . dca-rf)
+    ("activemessage" . activemessage)
+    ("rtf" . rtf)
+    ("applefile" . applefile)
+    ("mac-binhex40" . mac-binhex40)
+    ("news-message-id" . news-message-id)
+    ("news-transmissio" . news-transmissio)
+    ("wordperfect5.1" . wordperfect5.1)
+    ("pdf" . pdf)
+    ("zip" . zip)
+    ("macwritei" . macwritei)
+    ;; "image"
+    ("jpeg" . jpeg)
+    ("gif" . gif)
+    ("ief" . ief)
+    ("tiff" . tiff)
+    ;; "audio"
+    ("basic" . basic)
+    ;; "video" .
+    ("mpeg" . mpeg)
+    ("quicktime" . quicktime)))
+
+;; Basic structures
+(define-struct message (version entity fields)
+  #:mutable)
+(define-struct entity
+  (type subtype charset encoding disposition params id description other
+   fields parts body)
+  #:mutable)
+(define-struct disposition
+  (type filename creation modification read size params)
+  #:mutable)
+
+;; Exceptions
+(define-struct mime-error ())
+(define-struct (unexpected-termination mime-error) (msg))
+(define-struct (missing-multipart-boundary-parameter mime-error) ())
+(define-struct (malformed-multipart-entity mime-error) (msg))
+(define-struct (empty-mechanism mime-error) ())
+(define-struct (empty-type mime-error) ())
+(define-struct (empty-subtype mime-error) ())
+(define-struct (empty-disposition-type mime-error) ())
+
+;; *************************************
+;; Practical stuff, aka MIME in action:
+;; *************************************
+(define CRLF (format "~a~a" #\return #\newline))
+(define CRLF-binary "=0D=0A") ;; quoted printable representation
+
+;; get-headers : input-port -> string
+;; returns the header part of a message/part conforming to rfc822, and
+;; rfc2045.
+(define (get-headers in)
+  (let loop ([headers ""] [ln (read-line in 'any)])
+    (cond [(eof-object? ln)
+           ;; (raise (make-unexpected-termination "eof reached! while parsing headers"))
+           (warning "premature eof while parsing headers")
+           headers]
+          [(string=? ln "") headers]
+          [else
+           ;; Quoting rfc822:
+           ;; " Headers occur before the message body and are
+           ;; terminated by a null line (i.e., two contiguous
+           ;; CRLFs)."
+           ;; That is: Two empty lines.  But most MUAs seem to count
+           ;; the CRLF ending the last field (header) as the first
+           ;; CRLF of the null line.
+           (loop (string-append headers ln CRLF)
+                 (read-line in 'any))])))
+
+(define (make-default-disposition)
+  (make-disposition
+   'inline ;; type
+   "" ;; filename
+   #f ;; creation
+   #f ;; modification
+   #f ;; read
+   #f ;; size
+   null ;; params
+   ))
+
+(define (make-default-entity)
+  (make-entity
+   'text  ;; type
+   'plain ;; subtype
+   'us-ascii ;; charset
+   '7bit  ;; encoding
+   (make-default-disposition) ;; disposition
+   null   ;; params
+   ""     ;; id
+   ""     ;; description
+   null   ;; other MIME fields (MIME-extension-fields)
+   null   ;; fields
+   null   ;; parts
+   null   ;; body
+   ))
+
+(define (make-default-message)
+  (make-message 1.0 (make-default-entity) null))
+
+(define (mime-decode entity input)
+  (set-entity-body!
+   entity
+   (case (entity-encoding entity)
+     [(quoted-printable)
+      (lambda (output)
+        (qp-decode-stream input output))]
+     [(base64)
+      (lambda (output)
+        (base64-decode-stream input output))]
+     [else ;; 7bit, 8bit, binary
+      (lambda (output)
+        (copy-port input output))])))
+
+(define (mime-analyze input [part #f])
+  (let* ([iport (if (bytes? input)
+                  (open-input-bytes input)
+                  input)]
+         [headers (get-headers iport)]
+         [msg (if part
+                (MIME-part-headers headers)
+                (MIME-message-headers headers))]
+         [entity (message-entity msg)])
+    ;; OK we have in msg a MIME-message structure, lets see what we have:
+    (case (entity-type entity)
+      [(text image audio video application)
+       ;; decode part, and save port and thunk
+       (mime-decode entity iport)]
+      [(message multipart)
+       (let ([boundary (entity-boundary entity)])
+         (when (not boundary)
+           (when (eq? 'multipart (entity-type entity))
+             (raise (make-missing-multipart-boundary-parameter))))
+         (set-entity-parts! entity
+                            (map (lambda (part)
+                                   (mime-analyze part #t))
+                                 (if boundary
+                                   (multipart-body iport boundary)
+                                   (list iport)))))]
+      [else
+       ;; Unrecognized type, you're on your own! (sorry)
+       (mime-decode entity iport)])
+    ;; return mime structure
+    msg))
+
+(define (entity-boundary entity)
+  (let* ([params (entity-params entity)]
+         [ans (assoc "boundary" params)])
+    (and ans (cdr ans))))
+
+;; *************************************************
+;; MIME Specific: rfc2045-2049, and rfc0822, rfc2183
+;; *************************************************
+
+;;multipart-body := [preamble CRLF]
+;;                  dash-boundary transport-padding CRLF
+;;                  body-part *encapsulation
+;;                  close-delimiter transport-padding
+;;                  [CRLF epilogue]
+;; Returns a list of input ports, each one containing the correspongind part.
+(define (multipart-body input boundary)
+  (let* ([make-re (lambda (prefix)
+                    (regexp (string-append prefix "--" (regexp-quote boundary) "(--)?\r\n")))]
+         [re (make-re "\r\n")])
+    (letrec ([eat-part (lambda ()
+                         (let-values ([(pin pout) (make-pipe)])
+                           (let ([m (regexp-match re input 0 #f pout)])
+                             (cond
+                               [(not m)
+                                (close-output-port pout)
+                                (values pin ;; part
+                                        #f  ;; close-delimiter?
+                                        #t  ;; eof reached?
+                                        )]
+                               [(cadr m)
+                                (close-output-port pout)
+                                (values pin #t #f)]
+                               [else
+                                (close-output-port pout)
+                                (values pin #f #f)]))))])
+      ;; pre-amble is allowed to be completely empty:
+      (if (regexp-match-peek (make-re "^") input)
+        ;; No \r\f before first separator:
+        (read-line input)
+        ;; non-empty preamble:
+        (eat-part))
+      (let loop ()
+        (let-values ([(part close? eof?) (eat-part)])
+          (cond [close? (list part)]
+                [eof? (list part)]
+                [else (cons part (loop))]))))))
+
+;; MIME-message-headers := entity-headers
+;;                        fields
+;;                        version CRLF
+;;                        ; The ordering of the header
+;;                        ; fields implied by this BNF
+;;                        ; definition should be ignored.
+(define (MIME-message-headers headers)
+  (let ([message (make-default-message)])
+    (entity-headers headers message #t)
+    message))
+
+;; MIME-part-headers := entity-headers
+;;                     [ fields ]
+;;                     ; Any field not beginning with
+;;                     ; "content-" can have no defined
+;;                     ; meaning and may be ignored.
+;;                     ; The ordering of the header
+;;                     ; fields implied by this BNF
+;;                     ; definition should be ignored.
+(define (MIME-part-headers headers)
+  (let ([message (make-default-message)])
+    (entity-headers headers message #f)
+    message))
+
+;; entity-headers := [ content CRLF ]
+;;                  [ encoding CRLF ]
+;;                  [ id CRLF ]
+;;                  [ description CRLF ]
+;;                  *( MIME-extension-field CRLF )
+(define (entity-headers headers message version?)
+  (let ([entity (message-entity message)])
+    (let-values ([(mime non-mime) (get-fields headers)])
+      (let loop ([fields mime])
+        (unless (null? fields)
+          ;; Process MIME field
+          (let ([trimmed-h (trim-comments (car fields))])
+            (or (and version? (version trimmed-h message))
+                (content trimmed-h entity)
+                (encoding trimmed-h entity)
+                (dispositione trimmed-h entity)
+                (id trimmed-h entity)
+                (description trimmed-h entity)
+                (MIME-extension-field trimmed-h entity))
+            ;; keep going
+            (loop (cdr fields)))))
+      ;; NON-mime headers (or semantically incorrect). In order to make
+      ;; this implementation of rfc2045 robuts, we will save the header in
+      ;; the fields field of the message struct:
+      (set-message-fields! message non-mime)
+      ;; Return message
+      message)))
+
+(define (get-fields headers)
+  (let ([mime null] [non-mime null])
+    (letrec ([store-field
+              (lambda (f)
+                (unless (string=? f "")
+                  (if (mime-header? f)
+                    (set! mime (append mime (list (trim-spaces f))))
+                    (set! non-mime (append non-mime (list (trim-spaces f)))))))])
+      (let ([fields (extract-all-fields headers)])
+        (for-each (lambda (p)
+                    (store-field (format "~a: ~a" (car p) (cdr p))))
+                  fields))
+      (values mime non-mime))))
+
+(define re:content #rx"^(?i:content-)")
+(define re:mime #rx"^(?i:mime-version):")
+
+(define (mime-header? h)
+  (or (regexp-match? re:content h)
+      (regexp-match? re:mime h)))
+
+;;; Headers
+;;; Content-type follows this BNF syntax:
+;; content := "Content-Type" ":" type "/" subtype
+;;           *(";" parameter)
+;;           ; Matching of media type and subtype
+;;           ; is ALWAYS case-insensitive.
+(define re:content-type #rx"^(?i:content-type):([^/]+)/([^/]+)$")
+(define (content header entity)
+  (let* ([params (string-tokenizer #\; header)]
+         [one re:content-type]
+         [h (trim-all-spaces (car params))]
+         [target (regexp-match one h)]
+         [old-param (entity-params entity)])
+    (and target
+         (set-entity-type! entity
+                           (type (regexp-replace one h "\\1")))   ;; type
+         (set-entity-subtype! entity
+                              (subtype (regexp-replace one h "\\2"))) ;; subtype
+         (set-entity-params!
+          entity
+          (append old-param
+                  (let loop ([p (cdr params)] ;; parameters
+                             [ans null])
+                    (cond [(null? p) ans]
+                          [else
+                           (let ([par-pair (parameter (trim-all-spaces (car p)))])
+                             (cond [par-pair
+                                    (when (string=? (car par-pair) "charset")
+                                      (set-entity-charset! entity (cdr par-pair)))
+                                    (loop (cdr p) (append ans (list par-pair)))]
+                                   [else
+                                    (warning "Invalid parameter for Content-Type: `~a'" (car p))
+                                    ;; go on...
+                                    (loop (cdr p) ans)]))])))))))
+
+;; From rfc2183 Content-Disposition
+;; disposition := "Content-Disposition" ":"
+;;                  disposition-type
+;;                  *(";" disposition-parm)
+(define re:content-disposition #rx"^(?i:content-disposition):(.+)$")
+(define (dispositione header entity)
+  (let* ([params (string-tokenizer #\; header)]
+         [reg re:content-disposition]
+         [h (trim-all-spaces (car params))]
+         [target (regexp-match reg h)]
+         [disp-struct (entity-disposition entity)])
+    (and target
+         (set-disposition-type!
+          disp-struct
+          (disp-type (regexp-replace reg h "\\1")))
+         (disp-params (cdr params) disp-struct))))
+
+;; version := "MIME-Version" ":" 1*DIGIT "." 1*DIGIT
+(define re:mime-version #rx"^(?i:MIME-Version):([0-9]+)\\.([0-9]+)$")
+(define (version header message)
+  (let* ([reg re:mime-version]
+         [h (trim-all-spaces header)]
+         [target (regexp-match reg h)])
+    (and target
+         (set-message-version!
+          message
+          (string->number (regexp-replace reg h "\\1.\\2"))))))
+
+;;   description := "Content-Description" ":" *text
+(define re:content-description #rx"^(?i:content-description):[ \t\r\n]*(.*)$")
+(define (description header entity)
+  (let* ([reg re:content-description]
+         [target (regexp-match reg header)])
+    (and target
+         (set-entity-description!
+          entity
+          (trim-spaces (regexp-replace reg header "\\1"))))))
+
+;;   encoding := "Content-Transfer-Encoding" ":" mechanism
+(define re:content-transfer-encoding #rx"^(?i:content-transfer-encoding):(.+)$")
+(define (encoding header entity)
+  (let* ([reg re:content-transfer-encoding]
+         [h (trim-all-spaces header)]
+         [target (regexp-match reg h)])
+    (and target
+         (set-entity-encoding!
+          entity
+          (mechanism (regexp-replace reg h "\\1"))))))
+
+;;   id := "Content-ID" ":" msg-id
+(define re:content-id #rx"^(?i:content-id):(.+)$")
+(define (id header entity)
+  (let* ([reg re:content-id]
+         [h (trim-all-spaces header)]
+         [target (regexp-match reg h)])
+    (and target
+         (set-entity-id!
+          entity
+          (msg-id (regexp-replace reg h "\\1"))))))
+
+;; From rfc822:
+;; msg-id      =  "<" addr-spec ">"            ; Unique message id
+;; addr-spec   =  local-part "@" domain        ; global address
+;; local-part  =  word *("." word)             ; uninterpreted
+;;                                             ; case-preserved
+;; domain      =  sub-domain *("." sub-domain)
+;; sub-domain  =  domain-ref / domain-literal
+;; domain-literal =  "[" *(dtext / quoted-pair) "]"
+;; domain-ref  =  atom                         ; symbolic reference
+(define (msg-id str)
+  (let* ([r (regexp "^<[^@>]+@[^.]+(\\.[^.]+)*>$")]
+         [ans (regexp-match r str)])
+    (if ans
+      str
+      (begin (warning "Invalid msg-id: ~a" str) str))))
+
+;;  mechanism := "7bit" / "8bit" / "binary" /
+;;                 "quoted-printable" / "base64" /
+;;                 ietf-token / x-token
+(define (mechanism mech)
+  (if (not mech)
+    (raise (make-empty-mechanism))
+    (let ([val (assoc (lowercase mech) mechanism-alist)])
+      (or (and val (cdr val))
+          (ietf-token mech)
+          (x-token mech)))))
+
+;;  MIME-extension-field := <Any RFC 822 header field which
+;;                              begins with the string
+;;                              "Content-">
+;;
+(define (MIME-extension-field header entity)
+  (let* ([reg (regexp "^[Cc]ontent-(.+):[ \t]*(.+)$")]
+         [target (regexp-match reg header)])
+    (and target
+         (set-entity-other!
+          entity
+          (append (entity-other entity)
+                  (list (cons (regexp-replace reg header "\\1")
+                              (trim-spaces (regexp-replace reg header "\\2")))))))))
+
+;; type := discrete-type / composite-type
+(define (type value)
+  (if (not value)
+    (raise (make-empty-type))
+    (or (discrete-type value)
+        (composite-type value))))
+
+;; disposition-type := "inline" / "attachment"  / extension-token
+(define (disp-type value)
+  (if (not value)
+    (raise (make-empty-disposition-type))
+    (let ([val (assoc (lowercase (trim-spaces value)) disposition-alist)])
+      (if val (cdr val) (extension-token value)))))
+
+;; discrete-type := "text" / "image" / "audio" / "video" /
+;;                  "application" / extension-token
+(define (discrete-type value)
+  (let ([val (assoc (lowercase (trim-spaces value)) discrete-alist)])
+    (if val (cdr val) (extension-token value))))
+
+;; composite-type := "message" / "multipart" / extension-token
+(define (composite-type value)
+  (let ([val (assoc (lowercase (trim-spaces value)) composite-alist)])
+    (if val (cdr val) (extension-token value))))
+
+;; extension-token := ietf-token / x-token
+(define (extension-token value)
+  (or (ietf-token value)
+      (x-token value)))
+
+;; ietf-token := <An extension token defined by a
+;;               standards-track RFC and registered
+;;               with IANA.>
+(define (ietf-token value)
+  (let ([ans (assoc (lowercase (trim-spaces value)) ietf-extensions)])
+    (and ans (cdr ans))))
+
+;;  Directly from RFC 1700:
+;; Type            Subtype         Description                 Reference
+;; ----            -------         -----------                 ---------
+;; text            plain                                   [RFC1521,NSB]
+;;                 richtext                                [RFC1521,NSB]
+;;                 tab-separated-values                   [Paul Lindner]
+;;
+;; multipart       mixed                                   [RFC1521,NSB]
+;;                 alternative                             [RFC1521,NSB]
+;;                 digest                                  [RFC1521,NSB]
+;;                 parallel                                [RFC1521,NSB]
+;;                 appledouble                [MacMime,Patrik Faltstrom]
+;;                 header-set                             [Dave Crocker]
+;;
+;; message         rfc822                                  [RFC1521,NSB]
+;;                 partial                                 [RFC1521,NSB]
+;;                 external-body                           [RFC1521,NSB]
+;;                 news                        [RFC 1036, Henry Spencer]
+;;
+;; application     octet-stream                            [RFC1521,NSB]
+;;                   postscript                              [RFC1521,NSB]
+;;                   oda                                     [RFC1521,NSB]
+;;                   atomicmail                           [atomicmail,NSB]
+;;                   andrew-inset                       [andrew-inset,NSB]
+;;                   slate                           [slate,terry crowley]
+;;                   wita              [Wang Info Transfer,Larry Campbell]
+;;                   dec-dx            [Digital Doc Trans, Larry Campbell]
+;;                   dca-rft        [IBM Doc Content Arch, Larry Campbell]
+;;                   activemessage                          [Ehud Shapiro]
+;;                   rtf                                    [Paul Lindner]
+;;                   applefile                  [MacMime,Patrik Faltstrom]
+;;                   mac-binhex40               [MacMime,Patrik Faltstrom]
+;;                   news-message-id              [RFC1036, Henry Spencer]
+;;                   news-transmission            [RFC1036, Henry Spencer]
+;;                   wordperfect5.1                         [Paul Lindner]
+;;                   pdf                                    [Paul Lindner]
+;;                   zip                                    [Paul Lindner]
+;;                   macwriteii                             [Paul Lindner]
+;;                   msword                                 [Paul Lindner]
+;;                   remote-printing                         [RFC1486,MTR]
+;;
+;; image           jpeg                                    [RFC1521,NSB]
+;;                 gif                                     [RFC1521,NSB]
+;;                 ief             Image Exchange Format       [RFC1314]
+;;                 tiff            Tag Image File Format           [MTR]
+;;
+;; audio           basic                                   [RFC1521,NSB]
+;;
+;; video           mpeg                                    [RFC1521,NSB]
+;;                 quicktime                              [Paul Lindner]
+
+;; x-token := <The two characters "X-" or "x-" followed, with
+;;            no intervening white space, by any token>
+(define (x-token value)
+  (let* ([r  #rx"^[xX]-(.*)"]
+         [h (trim-spaces value)]
+         [ans (regexp-match r h)])
+    (and ans
+         (token (regexp-replace r h "\\1"))
+         h)))
+
+;; subtype := extension-token / iana-token
+(define (subtype value)
+  (if (not value)
+    (raise (make-empty-subtype))
+    (or (extension-token value)
+        (iana-token value))))
+
+;; iana-token := <A publicly-defined extension token. Tokens
+;;               of this form must be registered with IANA
+;;               as specified in RFC 2048.>
+(define (iana-token value)
+  (let ([ans (assoc (lowercase (trim-spaces value)) iana-extensions)])
+    (and ans (cdr ans))))
+
+;; parameter := attribute "=" value
+(define re:parameter (regexp "([^=]+)=(.+)"))
+(define (parameter par)
+  (let* ([r re:parameter]
+         [att (attribute (regexp-replace r par "\\1"))]
+         [val (value (regexp-replace r par "\\2"))])
+    (if (regexp-match r par)
+      (cons (if att (lowercase att) "???") val)
+      (cons "???" par))))
+
+;; value := token / quoted-string
+(define (value val)
+  (or (token val)
+      (quoted-string val)
+      val))
+
+;; token := 1*<any (US-ASCII) CHAR except SPACE, CTLs,
+;;            or tspecials>
+;; tspecials :=  "(" / ")" / "<" / ">" / "@" /
+;;              "," / ";" / ":" / "\" / <">
+;;              "/" / "[" / "]" / "?" / "="
+;;              ; Must be in quoted-string,
+;;              ; to use within parameter values
+(define (token value)
+  (let* ([tspecials (regexp "[^][()<>@,;:\\\"/?= ]+")]
+         [ans (regexp-match tspecials value)])
+    (and ans
+         (string=? value (car ans))
+         (car ans))))
+
+;; attribute := token
+;;             ; Matching of attributes
+;;             ; is ALWAYS case-insensitive.
+(define attribute token)
+
+(define re:quotes (regexp "\"(.+)\""))
+(define (quoted-string str)
+  (let* ([quotes re:quotes]
+         [ans (regexp-match quotes str)])
+    (and ans (regexp-replace quotes str "\\1"))))
+
+;; disposition-parm := filename-parm
+;;                     / creation-date-parm
+;;                     / modification-date-parm
+;;                     / read-date-parm
+;;                     / size-parm
+;;                     / parameter
+;;
+;; filename-parm := "filename" "=" value
+;;
+;; creation-date-parm := "creation-date" "=" quoted-date-time
+;;
+;; modification-date-parm := "modification-date" "=" quoted-date-time
+;;
+;; read-date-parm := "read-date" "=" quoted-date-time
+;;
+;; size-parm := "size" "=" 1*DIGIT
+(define (disp-params lst disp)
+  (let loop ([lst lst])
+    (unless (null? lst)
+      (let* ([p (parameter (trim-all-spaces (car lst)))]
+             [parm (car p)]
+             [value (cdr p)])
+        (cond [(string=? parm "filename")
+               (set-disposition-filename! disp value)]
+              [(string=? parm "creation-date")
+               (set-disposition-creation!
+                disp
+                (disp-quoted-data-time value))]
+              [(string=? parm "modification-date")
+               (set-disposition-modification!
+                disp
+                (disp-quoted-data-time value))]
+              [(string=? parm "read-date")
+               (set-disposition-read!
+                disp
+                (disp-quoted-data-time value))]
+              [(string=? parm "size")
+               (set-disposition-size!
+                disp
+                (string->number value))]
+              [else
+               (set-disposition-params!
+                disp
+                (append (disposition-params disp) (list p)))])
+        (loop (cdr lst))))))
+
+;; date-time   =  [ day "," ] date time        ; dd mm yy
+;;                                             ;  hh:mm:ss zzz
+;;
+;; day         =  "Mon"  / "Tue" /  "Wed"  / "Thu"
+;;            /  "Fri"  / "Sat" /  "Sun"
+;;
+;; date        =  1*2DIGIT month 2DIGIT        ; day month year
+;;                                   ;  e.g. 20 Jun 82
+;;
+;; month       =  "Jan"  /  "Feb" /  "Mar"  /  "Apr"
+;;            /  "May"  /  "Jun" /  "Jul"  /  "Aug"
+;;            /  "Sep"  /  "Oct" /  "Nov"  /  "Dec"
+;;
+;; time        =  hour zone                    ; ANSI and Military
+;;
+;; hour        =  2DIGIT ":" 2DIGIT [":" 2DIGIT]
+;;                                   ; 00:00:00 - 23:59:59
+;;
+;; zone        =  "UT"  / "GMT"                ; Universal Time
+;;                                   ; North American : UT
+;;            /  "EST" / "EDT"                ;  Eastern:  - 5/ - 4
+;;            /  "CST" / "CDT"                ;  Central:  - 6/ - 5
+;;            /  "MST" / "MDT"                ;  Mountain: - 7/ - 6
+;;            /  "PST" / "PDT"                ;  Pacific:  - 8/ - 7
+;;            /  1ALPHA                       ; Military: Z = UT;
+;;                                   ;  A:-1; (J not used)
+;;                                   ;  M:-12; N:+1; Y:+12
+;;            / ( ("+" / "-") 4DIGIT )        ; Local differential
+;;                                   ;  hours+min. (HHMM)
+(define date-time
+  (lambda (str)
+    ;; Fix Me: I have to return a date structure, or time in seconds.
+    str))
+
+;; quoted-date-time := quoted-string
+;;                ; contents MUST be an RFC 822 `date-time'
+;;                ; numeric timezones (+HHMM or -HHMM) MUST be used
+
+(define disp-quoted-data-time date-time)
diff --git a/collects/net/nntp-unit.rkt b/collects/net/nntp-unit.rkt
index 408f0a9059..0650418617 100644
--- a/collects/net/nntp-unit.rkt
+++ b/collects/net/nntp-unit.rkt
@@ -1,310 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/tcp "nntp-sig.rkt")
+(require racket/unit
+         "nntp-sig.rkt" "nntp.rkt")
 
-(import)
-(export nntp^)
+(define-unit-from-context nntp@ nntp^)
 
-;; sender : oport
-;; receiver : iport
-;; server : string
-;; port : number
-
-(define-struct communicator (sender receiver server port))
-
-;; code : number
-;; text : string
-;; line : string
-;; communicator : communicator
-;; group : string
-;; article : number
-
-(define-struct (nntp exn) ())
-(define-struct (unexpected-response nntp) (code text))
-(define-struct (bad-status-line nntp) (line))
-(define-struct (premature-close nntp) (communicator))
-(define-struct (bad-newsgroup-line nntp) (line))
-(define-struct (non-existent-group nntp) (group))
-(define-struct (article-not-in-group nntp) (article))
-(define-struct (no-group-selected nntp) ())
-(define-struct (article-not-found nntp) (article))
-(define-struct (authentication-rejected nntp) ())
-
-;; signal-error :
-;; (exn-args ... -> exn) x format-string x values ... ->
-;;   exn-args -> ()
-
-;; - throws an exception
-
-(define (signal-error constructor format-string . args)
-  (lambda exn-args
-    (raise (apply constructor
-                  (apply format format-string args)
-                  (current-continuation-marks)
-                  exn-args))))
-
-;; default-nntpd-port-number :
-;; number
-
-(define default-nntpd-port-number 119)
-
-;; connect-to-server*:
-;; input-port output-port -> communicator
-
-(define connect-to-server*
-  (case-lambda
-   [(receiver sender)
-    (connect-to-server* receiver sender "unspecified" "unspecified")]
-   [(receiver sender server-name port-number)
-    (file-stream-buffer-mode sender 'line)
-    (let ([communicator (make-communicator sender receiver server-name
-                                           port-number)])
-      (let-values ([(code response)
-                    (get-single-line-response communicator)])
-        (case code
-          [(200 201) communicator]
-          [else ((signal-error make-unexpected-response
-                               "unexpected connection response: ~s ~s"
-                               code response)
-                 code response)])))]))
-
-;; connect-to-server :
-;; string [x number] -> commnicator
-
-(define connect-to-server
-  (lambda (server-name (port-number default-nntpd-port-number))
-    (let-values ([(receiver sender)
-                  (tcp-connect server-name port-number)])
-      (connect-to-server* receiver sender server-name port-number))))
-
-;; close-communicator :
-;; communicator -> ()
-
-(define (close-communicator communicator)
-  (close-input-port (communicator-receiver communicator))
-  (close-output-port (communicator-sender communicator)))
-
-;; disconnect-from-server :
-;; communicator -> ()
-
-(define (disconnect-from-server communicator)
-  (send-to-server communicator "QUIT")
-  (let-values ([(code response)
-                (get-single-line-response communicator)])
-    (case code
-      [(205)
-       (close-communicator communicator)]
-      [else
-       ((signal-error make-unexpected-response
-                      "unexpected dis-connect response: ~s ~s"
-                      code response)
-        code response)])))
-
-;; authenticate-user :
-;; communicator x user-name x password -> ()
-;; the password is not used if the server does not ask for it.
-
-(define (authenticate-user communicator user password)
-  (define (reject code response)
-    ((signal-error make-authentication-rejected
-                   "authentication rejected (~s ~s)"
-                   code response)))
-  (define (unexpected code response)
-    ((signal-error make-unexpected-response
-                   "unexpected response for authentication: ~s ~s"
-                   code response)
-     code response))
-  (send-to-server communicator "AUTHINFO USER ~a" user)
-  (let-values ([(code response) (get-single-line-response communicator)])
-    (case code
-      [(281) (void)] ; server doesn't ask for a password
-      [(381)
-       (send-to-server communicator "AUTHINFO PASS ~a" password)
-       (let-values ([(code response)
-                     (get-single-line-response communicator)])
-         (case code
-           [(281) (void)] ; done
-           [(502) (reject code response)]
-           [else (unexpected code response)]))]
-      [(502) (reject code response)]
-      [else (reject code response)
-            (unexpected code response)])))
-
-;; send-to-server :
-;; communicator x format-string x list (values) -> ()
-
-(define (send-to-server communicator message-template . rest)
-  (let ([sender (communicator-sender communicator)])
-    (apply fprintf sender
-           (string-append message-template "\r\n")
-           rest)
-    (flush-output sender)))
-
-;; parse-status-line :
-;; string -> number x string
-
-(define (parse-status-line line)
-  (if (eof-object? line)
-      ((signal-error make-bad-status-line "eof instead of a status line")
-       line)
-      (let ([match (cdr (or (regexp-match #rx"([0-9]+) (.*)" line)
-                            ((signal-error make-bad-status-line
-                                           "malformed status line: ~s" line)
-                             line)))])
-        (values (string->number (car match))
-                (cadr match)))))
-
-;; get-one-line-from-server :
-;; iport -> string
-
-(define (get-one-line-from-server server->client-port)
-  (read-line server->client-port 'return-linefeed))
-
-;; get-single-line-response :
-;; communicator -> number x string
-
-(define (get-single-line-response communicator)
-  (let* ([receiver (communicator-receiver communicator)]
-         [status-line (get-one-line-from-server receiver)])
-    (parse-status-line status-line)))
-
-;; get-rest-of-multi-line-response :
-;; communicator -> list (string)
-
-(define (get-rest-of-multi-line-response communicator)
-  (let ([receiver (communicator-receiver communicator)])
-    (let loop ([r '()])
-      (let ([l (get-one-line-from-server receiver)])
-        (cond
-          [(eof-object? l)
-           ((signal-error make-premature-close
-                          "port prematurely closed during multi-line response")
-            communicator)]
-          [(string=? l ".")  (reverse r)]
-          [(string=? l "..") (loop (cons "." r))]
-          [else              (loop (cons l r))])))))
-
-;; get-multi-line-response :
-;; communicator -> number x string x list (string)
-
-;; -- The returned values are the status code, the rest of the status
-;; response line, and the remaining lines.
-
-(define (get-multi-line-response communicator)
-  (let* ([receiver (communicator-receiver communicator)]
-         [status-line (get-one-line-from-server receiver)])
-    (let-values ([(code rest-of-line)
-                  (parse-status-line status-line)])
-      (values code rest-of-line (get-rest-of-multi-line-response communicator)))))
-
-;; open-news-group :
-;; communicator x string -> number x number x number
-
-;; -- The returned values are the number of articles, the first
-;; article number, and the last article number for that group.
-
-(define (open-news-group communicator group-name)
-  (send-to-server communicator "GROUP ~a" group-name)
-  (let-values ([(code rest-of-line)
-                (get-single-line-response communicator)])
-    (case code
-      [(211)
-       (let ([match (map string->number
-                         (cdr
-                          (or (regexp-match #rx"([0-9]+) ([0-9]+) ([0-9]+)" rest-of-line)
-                              ((signal-error make-bad-newsgroup-line
-                                             "malformed newsgroup open response: ~s"
-                                             rest-of-line)
-                               rest-of-line))))])
-         (let ([number-of-articles (car match)]
-               [first-article-number (cadr match)]
-               [last-article-number (caddr match)])
-           (values number-of-articles
-                   first-article-number
-                   last-article-number)))]
-      [(411)
-       ((signal-error make-non-existent-group
-                      "group ~s does not exist on server ~s"
-                      group-name (communicator-server communicator))
-        group-name)]
-      [else
-       ((signal-error make-unexpected-response
-                      "unexpected group opening response: ~s" code)
-        code rest-of-line)])))
-
-;; generic-message-command :
-;; string x number -> communicator x (number U string) -> list (string)
-
-(define (generic-message-command command ok-code)
-  (lambda (communicator message-index)
-    (send-to-server communicator (string-append command " ~a")
-                    (if (number? message-index)
-                        (number->string message-index)
-                        message-index))
-    (let-values ([(code response)
-                  (get-single-line-response communicator)])
-      (if (= code ok-code)
-          (get-rest-of-multi-line-response communicator)
-          (case code
-            [(423)
-             ((signal-error make-article-not-in-group
-                            "article id ~s not in group" message-index)
-              message-index)]
-            [(412)
-             ((signal-error make-no-group-selected
-                            "no group selected"))]
-            [(430)
-             ((signal-error make-article-not-found
-                            "no article id ~s found" message-index)
-              message-index)]
-            [else
-             ((signal-error make-unexpected-response
-                            "unexpected message access response: ~s" code)
-              code response)])))))
-
-;; head-of-message :
-;; communicator x (number U string) -> list (string)
-
-(define head-of-message
-  (generic-message-command "HEAD" 221))
-
-;; body-of-message :
-;; communicator x (number U string) -> list (string)
-
-(define body-of-message
-  (generic-message-command "BODY" 222))
-
-;; newnews-since :
-;; communicator x (number U string) -> list (string)
-
-(define newnews-since
-  (generic-message-command "NEWNEWS" 230))
-
-;; make-desired-header :
-;; string -> desired
-
-(define (make-desired-header raw-header)
-  (regexp
-   (string-append
-    "^"
-    (list->string
-     (apply append
-            (map (lambda (c)
-                   (cond
-                    [(char-lower-case? c)
-                     (list #\[ (char-upcase c) c #\])]
-                    [(char-upper-case? c)
-                     (list #\[ c (char-downcase c) #\])]
-                    [else
-                     (list c)]))
-                 (string->list raw-header))))
-    ":")))
-
-;; extract-desired-headers :
-;; list (string) x list (desired) -> list (string)
-
-(define (extract-desired-headers headers desireds)
-  (filter (lambda (header)
-            (ormap (lambda (matcher) (regexp-match matcher header))
-                   desireds))
-          headers))
+(provide nntp@)
diff --git a/collects/net/nntp.rkt b/collects/net/nntp.rkt
index 816aa5047d..da8ae8dfdb 100644
--- a/collects/net/nntp.rkt
+++ b/collects/net/nntp.rkt
@@ -1,6 +1,325 @@
 #lang racket/base
-(require racket/unit "nntp-sig.rkt" "nntp-unit.rkt")
 
-(define-values/invoke-unit/infer nntp@)
+(require racket/tcp)
 
-(provide-signature-elements nntp^)
+(provide (struct-out communicator)
+         connect-to-server connect-to-server* disconnect-from-server
+         authenticate-user open-news-group
+         head-of-message body-of-message
+         newnews-since generic-message-command
+         make-desired-header extract-desired-headers
+
+         (struct-out nntp)
+         (struct-out unexpected-response)
+         (struct-out bad-status-line)
+         (struct-out premature-close)
+         (struct-out bad-newsgroup-line)
+         (struct-out non-existent-group)
+         (struct-out article-not-in-group)
+         (struct-out no-group-selected)
+         (struct-out article-not-found)
+         (struct-out authentication-rejected))
+
+;; sender : oport
+;; receiver : iport
+;; server : string
+;; port : number
+
+(define-struct communicator (sender receiver server port))
+
+;; code : number
+;; text : string
+;; line : string
+;; communicator : communicator
+;; group : string
+;; article : number
+
+(define-struct (nntp exn) ())
+(define-struct (unexpected-response nntp) (code text))
+(define-struct (bad-status-line nntp) (line))
+(define-struct (premature-close nntp) (communicator))
+(define-struct (bad-newsgroup-line nntp) (line))
+(define-struct (non-existent-group nntp) (group))
+(define-struct (article-not-in-group nntp) (article))
+(define-struct (no-group-selected nntp) ())
+(define-struct (article-not-found nntp) (article))
+(define-struct (authentication-rejected nntp) ())
+
+;; signal-error :
+;; (exn-args ... -> exn) x format-string x values ... ->
+;;   exn-args -> ()
+
+;; - throws an exception
+
+(define (signal-error constructor format-string . args)
+  (lambda exn-args
+    (raise (apply constructor
+                  (apply format format-string args)
+                  (current-continuation-marks)
+                  exn-args))))
+
+;; default-nntpd-port-number :
+;; number
+
+(define default-nntpd-port-number 119)
+
+;; connect-to-server*:
+;; input-port output-port -> communicator
+
+(define connect-to-server*
+  (case-lambda
+   [(receiver sender)
+    (connect-to-server* receiver sender "unspecified" "unspecified")]
+   [(receiver sender server-name port-number)
+    (file-stream-buffer-mode sender 'line)
+    (let ([communicator (make-communicator sender receiver server-name
+                                           port-number)])
+      (let-values ([(code response)
+                    (get-single-line-response communicator)])
+        (case code
+          [(200 201) communicator]
+          [else ((signal-error make-unexpected-response
+                               "unexpected connection response: ~s ~s"
+                               code response)
+                 code response)])))]))
+
+;; connect-to-server :
+;; string [x number] -> commnicator
+
+(define connect-to-server
+  (lambda (server-name (port-number default-nntpd-port-number))
+    (let-values ([(receiver sender)
+                  (tcp-connect server-name port-number)])
+      (connect-to-server* receiver sender server-name port-number))))
+
+;; close-communicator :
+;; communicator -> ()
+
+(define (close-communicator communicator)
+  (close-input-port (communicator-receiver communicator))
+  (close-output-port (communicator-sender communicator)))
+
+;; disconnect-from-server :
+;; communicator -> ()
+
+(define (disconnect-from-server communicator)
+  (send-to-server communicator "QUIT")
+  (let-values ([(code response)
+                (get-single-line-response communicator)])
+    (case code
+      [(205)
+       (close-communicator communicator)]
+      [else
+       ((signal-error make-unexpected-response
+                      "unexpected dis-connect response: ~s ~s"
+                      code response)
+        code response)])))
+
+;; authenticate-user :
+;; communicator x user-name x password -> ()
+;; the password is not used if the server does not ask for it.
+
+(define (authenticate-user communicator user password)
+  (define (reject code response)
+    ((signal-error make-authentication-rejected
+                   "authentication rejected (~s ~s)"
+                   code response)))
+  (define (unexpected code response)
+    ((signal-error make-unexpected-response
+                   "unexpected response for authentication: ~s ~s"
+                   code response)
+     code response))
+  (send-to-server communicator "AUTHINFO USER ~a" user)
+  (let-values ([(code response) (get-single-line-response communicator)])
+    (case code
+      [(281) (void)] ; server doesn't ask for a password
+      [(381)
+       (send-to-server communicator "AUTHINFO PASS ~a" password)
+       (let-values ([(code response)
+                     (get-single-line-response communicator)])
+         (case code
+           [(281) (void)] ; done
+           [(502) (reject code response)]
+           [else (unexpected code response)]))]
+      [(502) (reject code response)]
+      [else (reject code response)
+            (unexpected code response)])))
+
+;; send-to-server :
+;; communicator x format-string x list (values) -> ()
+
+(define (send-to-server communicator message-template . rest)
+  (let ([sender (communicator-sender communicator)])
+    (apply fprintf sender
+           (string-append message-template "\r\n")
+           rest)
+    (flush-output sender)))
+
+;; parse-status-line :
+;; string -> number x string
+
+(define (parse-status-line line)
+  (if (eof-object? line)
+      ((signal-error make-bad-status-line "eof instead of a status line")
+       line)
+      (let ([match (cdr (or (regexp-match #rx"([0-9]+) (.*)" line)
+                            ((signal-error make-bad-status-line
+                                           "malformed status line: ~s" line)
+                             line)))])
+        (values (string->number (car match))
+                (cadr match)))))
+
+;; get-one-line-from-server :
+;; iport -> string
+
+(define (get-one-line-from-server server->client-port)
+  (read-line server->client-port 'return-linefeed))
+
+;; get-single-line-response :
+;; communicator -> number x string
+
+(define (get-single-line-response communicator)
+  (let* ([receiver (communicator-receiver communicator)]
+         [status-line (get-one-line-from-server receiver)])
+    (parse-status-line status-line)))
+
+;; get-rest-of-multi-line-response :
+;; communicator -> list (string)
+
+(define (get-rest-of-multi-line-response communicator)
+  (let ([receiver (communicator-receiver communicator)])
+    (let loop ([r '()])
+      (let ([l (get-one-line-from-server receiver)])
+        (cond
+          [(eof-object? l)
+           ((signal-error make-premature-close
+                          "port prematurely closed during multi-line response")
+            communicator)]
+          [(string=? l ".")  (reverse r)]
+          [(string=? l "..") (loop (cons "." r))]
+          [else              (loop (cons l r))])))))
+
+;; get-multi-line-response :
+;; communicator -> number x string x list (string)
+
+;; -- The returned values are the status code, the rest of the status
+;; response line, and the remaining lines.
+
+(define (get-multi-line-response communicator)
+  (let* ([receiver (communicator-receiver communicator)]
+         [status-line (get-one-line-from-server receiver)])
+    (let-values ([(code rest-of-line)
+                  (parse-status-line status-line)])
+      (values code rest-of-line (get-rest-of-multi-line-response communicator)))))
+
+;; open-news-group :
+;; communicator x string -> number x number x number
+
+;; -- The returned values are the number of articles, the first
+;; article number, and the last article number for that group.
+
+(define (open-news-group communicator group-name)
+  (send-to-server communicator "GROUP ~a" group-name)
+  (let-values ([(code rest-of-line)
+                (get-single-line-response communicator)])
+    (case code
+      [(211)
+       (let ([match (map string->number
+                         (cdr
+                          (or (regexp-match #rx"([0-9]+) ([0-9]+) ([0-9]+)" rest-of-line)
+                              ((signal-error make-bad-newsgroup-line
+                                             "malformed newsgroup open response: ~s"
+                                             rest-of-line)
+                               rest-of-line))))])
+         (let ([number-of-articles (car match)]
+               [first-article-number (cadr match)]
+               [last-article-number (caddr match)])
+           (values number-of-articles
+                   first-article-number
+                   last-article-number)))]
+      [(411)
+       ((signal-error make-non-existent-group
+                      "group ~s does not exist on server ~s"
+                      group-name (communicator-server communicator))
+        group-name)]
+      [else
+       ((signal-error make-unexpected-response
+                      "unexpected group opening response: ~s" code)
+        code rest-of-line)])))
+
+;; generic-message-command :
+;; string x number -> communicator x (number U string) -> list (string)
+
+(define (generic-message-command command ok-code)
+  (lambda (communicator message-index)
+    (send-to-server communicator (string-append command " ~a")
+                    (if (number? message-index)
+                        (number->string message-index)
+                        message-index))
+    (let-values ([(code response)
+                  (get-single-line-response communicator)])
+      (if (= code ok-code)
+          (get-rest-of-multi-line-response communicator)
+          (case code
+            [(423)
+             ((signal-error make-article-not-in-group
+                            "article id ~s not in group" message-index)
+              message-index)]
+            [(412)
+             ((signal-error make-no-group-selected
+                            "no group selected"))]
+            [(430)
+             ((signal-error make-article-not-found
+                            "no article id ~s found" message-index)
+              message-index)]
+            [else
+             ((signal-error make-unexpected-response
+                            "unexpected message access response: ~s" code)
+              code response)])))))
+
+;; head-of-message :
+;; communicator x (number U string) -> list (string)
+
+(define head-of-message
+  (generic-message-command "HEAD" 221))
+
+;; body-of-message :
+;; communicator x (number U string) -> list (string)
+
+(define body-of-message
+  (generic-message-command "BODY" 222))
+
+;; newnews-since :
+;; communicator x (number U string) -> list (string)
+
+(define newnews-since
+  (generic-message-command "NEWNEWS" 230))
+
+;; make-desired-header :
+;; string -> desired
+
+(define (make-desired-header raw-header)
+  (regexp
+   (string-append
+    "^"
+    (list->string
+     (apply append
+            (map (lambda (c)
+                   (cond
+                    [(char-lower-case? c)
+                     (list #\[ (char-upcase c) c #\])]
+                    [(char-upper-case? c)
+                     (list #\[ c (char-downcase c) #\])]
+                    [else
+                     (list c)]))
+                 (string->list raw-header))))
+    ":")))
+
+;; extract-desired-headers :
+;; list (string) x list (desired) -> list (string)
+
+(define (extract-desired-headers headers desireds)
+  (filter (lambda (header)
+            (ormap (lambda (matcher) (regexp-match matcher header))
+                   desireds))
+          headers))
diff --git a/collects/net/pop3-unit.rkt b/collects/net/pop3-unit.rkt
index 204a0c0c9d..5c5cc7c8f0 100644
--- a/collects/net/pop3-unit.rkt
+++ b/collects/net/pop3-unit.rkt
@@ -1,390 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/tcp "pop3-sig.rkt")
+(require racket/unit
+         "pop3-sig.rkt" "pop3.rkt")
 
-(import)
-(export pop3^)
+(define-unit-from-context pop3@ pop3^)
 
-;; Implements RFC 1939, Post Office Protocol - Version 3, Myers & Rose
-
-;; sender : oport
-;; receiver : iport
-;; server : string
-;; port : number
-;; state : symbol = (disconnected, authorization, transaction)
-
-(define-struct communicator (sender receiver server port [state #:mutable]))
-
-(define-struct (pop3 exn) ())
-(define-struct (cannot-connect pop3) ())
-(define-struct (username-rejected pop3) ())
-(define-struct (password-rejected pop3) ())
-(define-struct (not-ready-for-transaction pop3) (communicator))
-(define-struct (not-given-headers pop3) (communicator message))
-(define-struct (illegal-message-number pop3) (communicator message))
-(define-struct (cannot-delete-message exn) (communicator message))
-(define-struct (disconnect-not-quiet pop3) (communicator))
-(define-struct (malformed-server-response pop3) (communicator))
-
-;; signal-error :
-;; (exn-args ... -> exn) x format-string x values ... ->
-;;   exn-args -> ()
-
-(define (signal-error constructor format-string . args)
-  (lambda exn-args
-    (raise (apply constructor
-                  (apply format format-string args)
-                  (current-continuation-marks)
-                  exn-args))))
-
-;; signal-malformed-response-error :
-;; exn-args -> ()
-
-;; -- in practice, it takes only one argument: a communicator.
-
-(define signal-malformed-response-error
-  (signal-error make-malformed-server-response
-                "malformed response from server"))
-
-;; confirm-transaction-mode :
-;; communicator x string -> ()
-
-;; -- signals an error otherwise.
-
-(define (confirm-transaction-mode communicator error-message)
-  (unless (eq? (communicator-state communicator) 'transaction)
-    ((signal-error make-not-ready-for-transaction error-message)
-     communicator)))
-
-;; default-pop-port-number :
-;; number
-
-(define default-pop-port-number 110)
-
-(define-struct server-responses ())
-(define-struct (+ok server-responses) ())
-(define-struct (-err server-responses) ())
-
-;; connect-to-server*:
-;; input-port output-port -> communicator
-
-(define connect-to-server*
-  (case-lambda
-   [(receiver sender) (connect-to-server* receiver sender "unspecified" "unspecified")]
-   [(receiver sender server-name port-number)
-    (let ([communicator (make-communicator sender receiver server-name port-number
-                                           'authorization)])
-      (let ([response (get-status-response/basic communicator)])
-        (cond
-         [(+ok? response) communicator]
-         [(-err? response)
-          ((signal-error make-cannot-connect
-                         "cannot connect to ~a on port ~a"
-                         server-name port-number))])))]))
-
-;; connect-to-server :
-;; string [x number] -> communicator
-
-(define connect-to-server
-  (lambda (server-name (port-number default-pop-port-number))
-    (let-values ([(receiver sender) (tcp-connect server-name port-number)])
-      (connect-to-server* receiver sender server-name port-number))))
-
-;; authenticate/plain-text :
-;; string x string x communicator -> ()
-
-;; -- if authentication succeeds, sets the communicator's state to
-;; transaction.
-
-(define (authenticate/plain-text username password communicator)
-  (let ([sender (communicator-sender communicator)])
-    (send-to-server communicator "USER ~a" username)
-    (let ([status (get-status-response/basic communicator)])
-      (cond
-       [(+ok? status)
-        (send-to-server communicator "PASS ~a" password)
-        (let ([status (get-status-response/basic communicator)])
-          (cond
-           [(+ok? status)
-            (set-communicator-state! communicator 'transaction)]
-           [(-err? status)
-            ((signal-error make-password-rejected
-                           "password was rejected"))]))]
-       [(-err? status)
-        ((signal-error make-username-rejected
-                       "username was rejected"))]))))
-
-;; get-mailbox-status :
-;; communicator -> number x number
-
-;; -- returns number of messages and number of octets.
-
-(define (get-mailbox-status communicator)
-  (confirm-transaction-mode
-   communicator
-   "cannot get mailbox status unless in transaction mode")
-  (send-to-server communicator "STAT")
-  (apply values
-         (map string->number
-              (let-values ([(status result)
-                            (get-status-response/match
-                             communicator
-                             #rx"([0-9]+) ([0-9]+)"
-                             #f)])
-                result))))
-
-;; get-message/complete :
-;; communicator x number -> list (string) x list (string)
-
-(define (get-message/complete communicator message)
-  (confirm-transaction-mode
-   communicator
-   "cannot get message headers unless in transaction state")
-  (send-to-server communicator "RETR ~a" message)
-  (let ([status (get-status-response/basic communicator)])
-    (cond
-     [(+ok? status)
-      (split-header/body (get-multi-line-response communicator))]
-     [(-err? status)
-      ((signal-error make-illegal-message-number
-                     "not given message ~a" message)
-       communicator message)])))
-
-;; get-message/headers :
-;; communicator x number -> list (string)
-
-(define (get-message/headers communicator message)
-  (confirm-transaction-mode
-   communicator
-   "cannot get message headers unless in transaction state")
-  (send-to-server communicator "TOP ~a 0" message)
-  (let ([status (get-status-response/basic communicator)])
-    (cond
-     [(+ok? status)
-      (let-values ([(headers body)
-                    (split-header/body
-                     (get-multi-line-response communicator))])
-        headers)]
-     [(-err? status)
-      ((signal-error make-not-given-headers
-                     "not given headers to message ~a" message)
-       communicator message)])))
-
-;; get-message/body :
-;; communicator x number -> list (string)
-
-(define (get-message/body communicator message)
-  (let-values ([(headers body) (get-message/complete communicator message)])
-    body))
-
-;; split-header/body :
-;; list (string) -> list (string) x list (string)
-
-;; -- returns list of headers and list of body lines.
-
-(define (split-header/body lines)
-  (let loop ([lines lines] [header null])
-    (if (null? lines)
-        (values (reverse header) null)
-        (let ([first (car lines)]
-              [rest (cdr lines)])
-          (if (string=? first "")
-              (values (reverse header) rest)
-              (loop rest (cons first header)))))))
-
-;; delete-message :
-;; communicator x number -> ()
-
-(define (delete-message communicator message)
-  (confirm-transaction-mode
-   communicator
-   "cannot delete message unless in transaction state")
-  (send-to-server communicator "DELE ~a" message)
-  (let ([status (get-status-response/basic communicator)])
-    (cond
-     [(-err? status)
-      ((signal-error make-cannot-delete-message
-                     "no message numbered ~a available to be deleted" message)
-       communicator message)]
-     [(+ok? status)
-      'deleted])))
-
-;; regexp for UIDL responses
-
-(define uidl-regexp #rx"([0-9]+) (.*)")
-
-;; get-unique-id/single :
-;; communicator x number -> string
-
-(define (get-unique-id/single communicator message)
-  (confirm-transaction-mode
-   communicator
-   "cannot get unique message id unless in transaction state")
-  (send-to-server communicator "UIDL ~a" message)
-  (let-values ([(status result)
-                (get-status-response/match communicator uidl-regexp ".*")])
-    ;; The server response is of the form
-    ;; +OK 2 QhdPYR:00WBw1Ph7x7
-    (cond
-     [(-err? status)
-      ((signal-error make-illegal-message-number
-                     "no message numbered ~a available for unique id" message)
-       communicator message)]
-     [(+ok? status)
-      (cadr result)])))
-
-;; get-unique-id/all :
-;; communicator -> list(number x string)
-
-(define (get-unique-id/all communicator)
-  (confirm-transaction-mode communicator
-                            "cannot get unique message ids unless in transaction state")
-  (send-to-server communicator "UIDL")
-  (let ([status (get-status-response/basic communicator)])
-    ;; The server response is of the form
-    ;; +OK
-    ;; 1 whqtswO00WBw418f9t5JxYwZ
-    ;; 2 QhdPYR:00WBw1Ph7x7
-    ;; .
-    (map (lambda (l)
-           (let ([m (regexp-match uidl-regexp l)])
-             (cons (string->number (cadr m)) (caddr m))))
-         (get-multi-line-response communicator))))
-
-;; close-communicator :
-;; communicator -> ()
-
-(define (close-communicator communicator)
-  (close-input-port (communicator-receiver communicator))
-  (close-output-port (communicator-sender communicator)))
-
-;; disconnect-from-server :
-;; communicator -> ()
-
-(define (disconnect-from-server communicator)
-  (send-to-server communicator "QUIT")
-  (set-communicator-state! communicator 'disconnected)
-  (let ([response (get-status-response/basic communicator)])
-    (close-communicator communicator)
-    (cond
-     [(+ok? response) (void)]
-     [(-err? response)
-      ((signal-error make-disconnect-not-quiet
-                     "got error status upon disconnect")
-       communicator)])))
-
-;; send-to-server :
-;; communicator x format-string x list (values) -> ()
-
-(define (send-to-server communicator message-template . rest)
-  (apply fprintf (communicator-sender communicator)
-         (string-append message-template "\r\n")
-         rest)
-  (flush-output (communicator-sender communicator)))
-
-;; get-one-line-from-server :
-;; iport -> string
-
-(define (get-one-line-from-server server->client-port)
-  (read-line server->client-port 'return-linefeed))
-
-;; get-server-status-response :
-;; communicator -> server-responses x string
-
-;; -- provides the low-level functionality of checking for +OK
-;; and -ERR, returning an appropriate structure, and returning the
-;; rest of the status response as a string to be used for further
-;; parsing, if necessary.
-
-(define (get-server-status-response communicator)
-  (let* ([receiver (communicator-receiver communicator)]
-         [status-line (get-one-line-from-server receiver)]
-         [r (regexp-match #rx"^\\+OK(.*)" status-line)])
-    (if r
-        (values (make-+ok) (cadr r))
-        (let ([r (regexp-match #rx"^\\-ERR(.*)" status-line)])
-          (if r
-              (values (make--err) (cadr r))
-              (signal-malformed-response-error communicator))))))
-
-;; get-status-response/basic :
-;; communicator -> server-responses
-
-;; -- when the only thing to determine is whether the response
-;; was +OK or -ERR.
-
-(define (get-status-response/basic communicator)
-  (let-values ([(response rest)
-                (get-server-status-response communicator)])
-    response))
-
-;; get-status-response/match :
-;; communicator x regexp x regexp -> (status x list (string))
-
-;; -- when further parsing of the status response is necessary.
-;; Strips off the car of response from regexp-match.
-
-(define (get-status-response/match communicator +regexp -regexp)
-  (let-values ([(response rest)
-                (get-server-status-response communicator)])
-    (if (and +regexp (+ok? response))
-        (let ([r (regexp-match +regexp rest)])
-          (if r (values response (cdr r))
-              (signal-malformed-response-error communicator)))
-        (if (and -regexp (-err? response))
-            (let ([r (regexp-match -regexp rest)])
-              (if r (values response (cdr r))
-                  (signal-malformed-response-error communicator)))
-            (signal-malformed-response-error communicator)))))
-
-;; get-multi-line-response :
-;; communicator -> list (string)
-
-(define (get-multi-line-response communicator)
-  (let ([receiver (communicator-receiver communicator)])
-    (let loop ()
-      (let ([l (get-one-line-from-server receiver)])
-        (cond
-         [(eof-object? l)
-          (signal-malformed-response-error communicator)]
-         [(string=? l ".")
-          '()]
-         [(and (> (string-length l) 1)
-               (char=? (string-ref l 0) #\.))
-          (cons (substring l 1 (string-length l)) (loop))]
-         [else
-          (cons l (loop))])))))
-
-;; make-desired-header :
-;; string -> desired
-
-(define (make-desired-header raw-header)
-  (regexp
-   (string-append
-    "^"
-    (list->string
-     (apply append
-            (map (lambda (c)
-                   (cond
-                    [(char-lower-case? c)
-                     (list #\[ (char-upcase c) c #\])]
-                    [(char-upper-case? c)
-                     (list #\[ c (char-downcase c) #\])]
-                    [else
-                     (list c)]))
-                 (string->list raw-header))))
-    ":")))
-
-;; extract-desired-headers :
-;; list (string) x list (desired) -> list (string)
-
-(define (extract-desired-headers headers desireds)
-  (let loop ([headers headers])
-    (if (null? headers) null
-        (let ([first (car headers)]
-              [rest (cdr headers)])
-          (if (ormap (lambda (matcher)
-                       (regexp-match matcher first))
-                     desireds)
-              (cons first (loop rest))
-              (loop rest))))))
+(provide pop3@)
diff --git a/collects/net/pop3.rkt b/collects/net/pop3.rkt
index 099a9fa14a..2142b8cd8d 100644
--- a/collects/net/pop3.rkt
+++ b/collects/net/pop3.rkt
@@ -1,13 +1,9 @@
 #lang racket/base
-(require racket/unit "pop3-sig.rkt" "pop3-unit.rkt")
 
-(define-values/invoke-unit/infer pop3@)
-
-(provide-signature-elements pop3^)
+;; Implements RFC 1939, Post Office Protocol - Version 3, Myers & Rose
 
 #|
-
-> (require-library "pop3.rkt" "net")
+> (require net/pop3)
 > (define c (connect-to-server "cs.rice.edu"))
 > (authenticate/plain-text "scheme" "********" c)
 > (get-mailbox-status c)
@@ -28,3 +24,408 @@
 ("some body" "text" "goes" "." "here" "." "")
 > (disconnect-from-server c)
 |#
+
+(require racket/tcp)
+
+(provide (struct-out communicator)
+         connect-to-server connect-to-server* disconnect-from-server
+         authenticate/plain-text
+         get-mailbox-status
+         get-message/complete get-message/headers get-message/body
+         delete-message
+         get-unique-id/single get-unique-id/all
+
+         make-desired-header extract-desired-headers
+
+         (struct-out pop3)
+         (struct-out cannot-connect)
+         (struct-out username-rejected)
+         (struct-out password-rejected)
+         (struct-out not-ready-for-transaction)
+         (struct-out not-given-headers)
+         (struct-out illegal-message-number)
+         (struct-out cannot-delete-message)
+         (struct-out disconnect-not-quiet)
+         (struct-out malformed-server-response))
+
+;; sender : oport
+;; receiver : iport
+;; server : string
+;; port : number
+;; state : symbol = (disconnected, authorization, transaction)
+
+(define-struct communicator (sender receiver server port [state #:mutable]))
+
+(define-struct (pop3 exn) ())
+(define-struct (cannot-connect pop3) ())
+(define-struct (username-rejected pop3) ())
+(define-struct (password-rejected pop3) ())
+(define-struct (not-ready-for-transaction pop3) (communicator))
+(define-struct (not-given-headers pop3) (communicator message))
+(define-struct (illegal-message-number pop3) (communicator message))
+(define-struct (cannot-delete-message exn) (communicator message))
+(define-struct (disconnect-not-quiet pop3) (communicator))
+(define-struct (malformed-server-response pop3) (communicator))
+
+;; signal-error :
+;; (exn-args ... -> exn) x format-string x values ... ->
+;;   exn-args -> ()
+
+(define (signal-error constructor format-string . args)
+  (lambda exn-args
+    (raise (apply constructor
+                  (apply format format-string args)
+                  (current-continuation-marks)
+                  exn-args))))
+
+;; signal-malformed-response-error :
+;; exn-args -> ()
+
+;; -- in practice, it takes only one argument: a communicator.
+
+(define signal-malformed-response-error
+  (signal-error make-malformed-server-response
+                "malformed response from server"))
+
+;; confirm-transaction-mode :
+;; communicator x string -> ()
+
+;; -- signals an error otherwise.
+
+(define (confirm-transaction-mode communicator error-message)
+  (unless (eq? (communicator-state communicator) 'transaction)
+    ((signal-error make-not-ready-for-transaction error-message)
+     communicator)))
+
+;; default-pop-port-number :
+;; number
+
+(define default-pop-port-number 110)
+
+(define-struct server-responses ())
+(define-struct (+ok server-responses) ())
+(define-struct (-err server-responses) ())
+
+;; connect-to-server*:
+;; input-port output-port -> communicator
+
+(define connect-to-server*
+  (case-lambda
+   [(receiver sender) (connect-to-server* receiver sender "unspecified" "unspecified")]
+   [(receiver sender server-name port-number)
+    (let ([communicator (make-communicator sender receiver server-name port-number
+                                           'authorization)])
+      (let ([response (get-status-response/basic communicator)])
+        (cond
+         [(+ok? response) communicator]
+         [(-err? response)
+          ((signal-error make-cannot-connect
+                         "cannot connect to ~a on port ~a"
+                         server-name port-number))])))]))
+
+;; connect-to-server :
+;; string [x number] -> communicator
+
+(define connect-to-server
+  (lambda (server-name (port-number default-pop-port-number))
+    (let-values ([(receiver sender) (tcp-connect server-name port-number)])
+      (connect-to-server* receiver sender server-name port-number))))
+
+;; authenticate/plain-text :
+;; string x string x communicator -> ()
+
+;; -- if authentication succeeds, sets the communicator's state to
+;; transaction.
+
+(define (authenticate/plain-text username password communicator)
+  (let ([sender (communicator-sender communicator)])
+    (send-to-server communicator "USER ~a" username)
+    (let ([status (get-status-response/basic communicator)])
+      (cond
+       [(+ok? status)
+        (send-to-server communicator "PASS ~a" password)
+        (let ([status (get-status-response/basic communicator)])
+          (cond
+           [(+ok? status)
+            (set-communicator-state! communicator 'transaction)]
+           [(-err? status)
+            ((signal-error make-password-rejected
+                           "password was rejected"))]))]
+       [(-err? status)
+        ((signal-error make-username-rejected
+                       "username was rejected"))]))))
+
+;; get-mailbox-status :
+;; communicator -> number x number
+
+;; -- returns number of messages and number of octets.
+
+(define (get-mailbox-status communicator)
+  (confirm-transaction-mode
+   communicator
+   "cannot get mailbox status unless in transaction mode")
+  (send-to-server communicator "STAT")
+  (apply values
+         (map string->number
+              (let-values ([(status result)
+                            (get-status-response/match
+                             communicator
+                             #rx"([0-9]+) ([0-9]+)"
+                             #f)])
+                result))))
+
+;; get-message/complete :
+;; communicator x number -> list (string) x list (string)
+
+(define (get-message/complete communicator message)
+  (confirm-transaction-mode
+   communicator
+   "cannot get message headers unless in transaction state")
+  (send-to-server communicator "RETR ~a" message)
+  (let ([status (get-status-response/basic communicator)])
+    (cond
+     [(+ok? status)
+      (split-header/body (get-multi-line-response communicator))]
+     [(-err? status)
+      ((signal-error make-illegal-message-number
+                     "not given message ~a" message)
+       communicator message)])))
+
+;; get-message/headers :
+;; communicator x number -> list (string)
+
+(define (get-message/headers communicator message)
+  (confirm-transaction-mode
+   communicator
+   "cannot get message headers unless in transaction state")
+  (send-to-server communicator "TOP ~a 0" message)
+  (let ([status (get-status-response/basic communicator)])
+    (cond
+     [(+ok? status)
+      (let-values ([(headers body)
+                    (split-header/body
+                     (get-multi-line-response communicator))])
+        headers)]
+     [(-err? status)
+      ((signal-error make-not-given-headers
+                     "not given headers to message ~a" message)
+       communicator message)])))
+
+;; get-message/body :
+;; communicator x number -> list (string)
+
+(define (get-message/body communicator message)
+  (let-values ([(headers body) (get-message/complete communicator message)])
+    body))
+
+;; split-header/body :
+;; list (string) -> list (string) x list (string)
+
+;; -- returns list of headers and list of body lines.
+
+(define (split-header/body lines)
+  (let loop ([lines lines] [header null])
+    (if (null? lines)
+        (values (reverse header) null)
+        (let ([first (car lines)]
+              [rest (cdr lines)])
+          (if (string=? first "")
+              (values (reverse header) rest)
+              (loop rest (cons first header)))))))
+
+;; delete-message :
+;; communicator x number -> ()
+
+(define (delete-message communicator message)
+  (confirm-transaction-mode
+   communicator
+   "cannot delete message unless in transaction state")
+  (send-to-server communicator "DELE ~a" message)
+  (let ([status (get-status-response/basic communicator)])
+    (cond
+     [(-err? status)
+      ((signal-error make-cannot-delete-message
+                     "no message numbered ~a available to be deleted" message)
+       communicator message)]
+     [(+ok? status)
+      'deleted])))
+
+;; regexp for UIDL responses
+
+(define uidl-regexp #rx"([0-9]+) (.*)")
+
+;; get-unique-id/single :
+;; communicator x number -> string
+
+(define (get-unique-id/single communicator message)
+  (confirm-transaction-mode
+   communicator
+   "cannot get unique message id unless in transaction state")
+  (send-to-server communicator "UIDL ~a" message)
+  (let-values ([(status result)
+                (get-status-response/match communicator uidl-regexp ".*")])
+    ;; The server response is of the form
+    ;; +OK 2 QhdPYR:00WBw1Ph7x7
+    (cond
+     [(-err? status)
+      ((signal-error make-illegal-message-number
+                     "no message numbered ~a available for unique id" message)
+       communicator message)]
+     [(+ok? status)
+      (cadr result)])))
+
+;; get-unique-id/all :
+;; communicator -> list(number x string)
+
+(define (get-unique-id/all communicator)
+  (confirm-transaction-mode communicator
+                            "cannot get unique message ids unless in transaction state")
+  (send-to-server communicator "UIDL")
+  (let ([status (get-status-response/basic communicator)])
+    ;; The server response is of the form
+    ;; +OK
+    ;; 1 whqtswO00WBw418f9t5JxYwZ
+    ;; 2 QhdPYR:00WBw1Ph7x7
+    ;; .
+    (map (lambda (l)
+           (let ([m (regexp-match uidl-regexp l)])
+             (cons (string->number (cadr m)) (caddr m))))
+         (get-multi-line-response communicator))))
+
+;; close-communicator :
+;; communicator -> ()
+
+(define (close-communicator communicator)
+  (close-input-port (communicator-receiver communicator))
+  (close-output-port (communicator-sender communicator)))
+
+;; disconnect-from-server :
+;; communicator -> ()
+
+(define (disconnect-from-server communicator)
+  (send-to-server communicator "QUIT")
+  (set-communicator-state! communicator 'disconnected)
+  (let ([response (get-status-response/basic communicator)])
+    (close-communicator communicator)
+    (cond
+     [(+ok? response) (void)]
+     [(-err? response)
+      ((signal-error make-disconnect-not-quiet
+                     "got error status upon disconnect")
+       communicator)])))
+
+;; send-to-server :
+;; communicator x format-string x list (values) -> ()
+
+(define (send-to-server communicator message-template . rest)
+  (apply fprintf (communicator-sender communicator)
+         (string-append message-template "\r\n")
+         rest)
+  (flush-output (communicator-sender communicator)))
+
+;; get-one-line-from-server :
+;; iport -> string
+
+(define (get-one-line-from-server server->client-port)
+  (read-line server->client-port 'return-linefeed))
+
+;; get-server-status-response :
+;; communicator -> server-responses x string
+
+;; -- provides the low-level functionality of checking for +OK
+;; and -ERR, returning an appropriate structure, and returning the
+;; rest of the status response as a string to be used for further
+;; parsing, if necessary.
+
+(define (get-server-status-response communicator)
+  (let* ([receiver (communicator-receiver communicator)]
+         [status-line (get-one-line-from-server receiver)]
+         [r (regexp-match #rx"^\\+OK(.*)" status-line)])
+    (if r
+        (values (make-+ok) (cadr r))
+        (let ([r (regexp-match #rx"^\\-ERR(.*)" status-line)])
+          (if r
+              (values (make--err) (cadr r))
+              (signal-malformed-response-error communicator))))))
+
+;; get-status-response/basic :
+;; communicator -> server-responses
+
+;; -- when the only thing to determine is whether the response
+;; was +OK or -ERR.
+
+(define (get-status-response/basic communicator)
+  (let-values ([(response rest)
+                (get-server-status-response communicator)])
+    response))
+
+;; get-status-response/match :
+;; communicator x regexp x regexp -> (status x list (string))
+
+;; -- when further parsing of the status response is necessary.
+;; Strips off the car of response from regexp-match.
+
+(define (get-status-response/match communicator +regexp -regexp)
+  (let-values ([(response rest)
+                (get-server-status-response communicator)])
+    (if (and +regexp (+ok? response))
+        (let ([r (regexp-match +regexp rest)])
+          (if r (values response (cdr r))
+              (signal-malformed-response-error communicator)))
+        (if (and -regexp (-err? response))
+            (let ([r (regexp-match -regexp rest)])
+              (if r (values response (cdr r))
+                  (signal-malformed-response-error communicator)))
+            (signal-malformed-response-error communicator)))))
+
+;; get-multi-line-response :
+;; communicator -> list (string)
+
+(define (get-multi-line-response communicator)
+  (let ([receiver (communicator-receiver communicator)])
+    (let loop ()
+      (let ([l (get-one-line-from-server receiver)])
+        (cond
+         [(eof-object? l)
+          (signal-malformed-response-error communicator)]
+         [(string=? l ".")
+          '()]
+         [(and (> (string-length l) 1)
+               (char=? (string-ref l 0) #\.))
+          (cons (substring l 1 (string-length l)) (loop))]
+         [else
+          (cons l (loop))])))))
+
+;; make-desired-header :
+;; string -> desired
+
+(define (make-desired-header raw-header)
+  (regexp
+   (string-append
+    "^"
+    (list->string
+     (apply append
+            (map (lambda (c)
+                   (cond
+                    [(char-lower-case? c)
+                     (list #\[ (char-upcase c) c #\])]
+                    [(char-upper-case? c)
+                     (list #\[ c (char-downcase c) #\])]
+                    [else
+                     (list c)]))
+                 (string->list raw-header))))
+    ":")))
+
+;; extract-desired-headers :
+;; list (string) x list (desired) -> list (string)
+
+(define (extract-desired-headers headers desireds)
+  (let loop ([headers headers])
+    (if (null? headers) null
+        (let ([first (car headers)]
+              [rest (cdr headers)])
+          (if (ormap (lambda (matcher)
+                       (regexp-match matcher first))
+                     desireds)
+              (cons first (loop rest))
+              (loop rest))))))
diff --git a/collects/net/qp-unit.rkt b/collects/net/qp-unit.rkt
index 8cbc457456..1d7f2ebd3e 100644
--- a/collects/net/qp-unit.rkt
+++ b/collects/net/qp-unit.rkt
@@ -1,165 +1,8 @@
-;;;
-;;; <qp-unit.rkt> ---- Quoted Printable Implementation
-;;;
-;;; Copyright (C) 2002 by PLT.
-;;; Copyright (C) 2001 by Francisco Solsona.
-;;;
-;;; This file was part of mime-plt.
+#lang racket/base
 
-;;; mime-plt is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Lesser General Public
-;;; License as published by the Free Software Foundation; either
-;;; version 2.1 of the License, or (at your option) any later version.
+(require racket/unit
+         "qp-sig.rkt" "qp.rkt")
 
-;;; mime-plt is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Lesser General Public License for more details.
+(define-unit-from-context qp@ qp^)
 
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with mime-plt; if not, write to the Free Software
-;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-;;; 02110-1301 USA.
-
-;;; Author: Francisco Solsona <solsona@acm.org>
-;;
-;;
-;; Commentary:
-
-#lang racket/unit
-
-(require "qp-sig.rkt")
-
-(import)
-(export qp^)
-
-;; Exceptions:
-;; String or input-port expected:
-(define-struct qp-error ())
-(define-struct (qp-wrong-input qp-error) ())
-(define-struct (qp-wrong-line-size qp-error) (size))
-
-;; qp-encode : bytes -> bytes
-;; returns the quoted printable representation of STR.
-(define (qp-encode str)
-  (let ([out (open-output-bytes)])
-    (qp-encode-stream (open-input-bytes str) out #"\r\n")
-    (get-output-bytes out)))
-
-;; qp-decode : string -> string
-;; returns STR unqp.
-(define (qp-decode str)
-  (let ([out (open-output-bytes)])
-    (qp-decode-stream (open-input-bytes str) out)
-    (get-output-bytes out)))
-
-(define (qp-decode-stream in out)
-  (let loop ([ch (read-byte in)])
-    (unless (eof-object? ch)
-      (case ch
-        [(61) ;; A "=", which is quoted-printable stuff
-         (let ([next (read-byte in)])
-           (cond
-             [(eq? next 10)
-              ;; Soft-newline -- drop it
-              (void)]
-             [(eq? next 13)
-              ;; Expect a newline for a soft CRLF...
-              (let ([next-next (read-byte in)])
-                (if (eq? next-next 10)
-                  ;; Good.
-                  (loop (read-byte in))
-                  ;; Not a LF? Well, ok.
-                  (loop next-next)))]
-             [(hex-digit? next)
-              (let ([next-next (read-byte in)])
-                (cond [(eof-object? next-next)
-                       (warning "Illegal qp sequence: `=~a'" next)
-                       (display "=" out)
-                       (display next out)]
-                      [(hex-digit? next-next)
-                       ;; qp-encoded
-                       (write-byte (hex-bytes->byte next next-next)
-                                   out)]
-                      [else
-                       (warning "Illegal qp sequence: `=~a~a'" next next-next)
-                       (write-byte 61 out)
-                       (write-byte next out)
-                       (write-byte next-next out)]))]
-             [else
-              ;; Warning: invalid
-              (warning "Illegal qp sequence: `=~a'" next)
-              (write-byte 61 out)
-              (write-byte next out)])
-           (loop (read-byte in)))]
-        [else
-         (write-byte ch out)
-         (loop (read-byte in))]))))
-
-(define (warning msg . args)
-  (when #f
-    (fprintf (current-error-port)
-             (apply format msg args))
-    (newline (current-error-port))))
-
-(define (hex-digit? i)
-  (vector-ref hex-values i))
-
-(define (hex-bytes->byte b1 b2)
-  (+ (* 16 (vector-ref hex-values b1))
-     (vector-ref hex-values b2)))
-
-(define (write-hex-bytes byte p)
-  (write-byte 61 p)
-  (write-byte (vector-ref hex-bytes (arithmetic-shift byte -4)) p)
-  (write-byte (vector-ref hex-bytes (bitwise-and byte 15)) p))
-
-(define (qp-encode-stream in out [newline-string #"\n"])
-  (let loop ([col 0])
-    (if (= col 75)
-      (begin
-        ;; Soft newline:
-        (write-byte 61 out)
-        (display newline-string out)
-        (loop 0))
-      (let ([i (read-byte in)])
-        (cond
-          [(eof-object? i) (void)]
-          [(or (= i 10) (= i 13))
-           (write-byte i out)
-           (loop 0)]
-          [(or (<= 33 i 60) (<= 62 i 126)
-               (and (or (= i 32) (= i 9))
-                    (not (let ([next (peek-byte in)])
-                           (or (eof-object? next) (= next 10) (= next 13))))))
-           ;; single-byte mode:
-           (write-byte i out)
-           (loop (add1 col))]
-          [(>= col 73)
-           ;; need a soft newline first
-           (write-byte 61 out)
-           (display newline-string out)
-           ;; now the octect
-           (write-hex-bytes i out)
-           (loop 3)]
-          [else
-           ;; an octect
-           (write-hex-bytes i out)
-           (loop (+ col 3))])))))
-
-;; Tables
-(define hex-values (make-vector 256 #f))
-(define hex-bytes (make-vector 16))
-(let loop ([i 0])
-  (unless (= i 10)
-    (vector-set! hex-values (+ i 48) i)
-    (vector-set! hex-bytes i (+ i 48))
-    (loop (add1 i))))
-(let loop ([i 0])
-  (unless (= i 6)
-    (vector-set! hex-values (+ i 65) (+ 10 i))
-    (vector-set! hex-values (+ i 97) (+ 10 i))
-    (vector-set! hex-bytes (+ 10 i) (+ i 65))
-    (loop (add1 i))))
-
-;;; qp-unit.rkt ends here
+(provide qp@)
diff --git a/collects/net/qp.rkt b/collects/net/qp.rkt
index c5267fb6b1..7522a6c863 100644
--- a/collects/net/qp.rkt
+++ b/collects/net/qp.rkt
@@ -6,31 +6,166 @@
 ;;;
 ;;; This file is part of mime-plt.
 
-;;; mime-plt is free software; you can redistribute it and/or
+;;; qp is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
 ;;; License as published by the Free Software Foundation; either
 ;;; version 2.1 of the License, or (at your option) any later version.
 
-;;; mime-plt is distributed in the hope that it will be useful,
+;;; qp is distributed in the hope that it will be useful,
 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;; Lesser General Public License for more details.
 
 ;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with mime-plt; if not, write to the Free Software
+;;; License along with qp; if not, write to the Free Software
 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 ;;; 02110-1301 USA.
 
 ;;; Author: Francisco Solsona <solsona@acm.org>
 ;;
-;;
 ;; Commentary:
 
 #lang racket/base
-(require racket/unit "qp-sig.rkt" "qp-unit.rkt")
 
-(define-values/invoke-unit/infer qp@)
+(provide
+ ;; -- exceptions raised --
+ (struct-out qp-error)
+ (struct-out qp-wrong-input)
+ (struct-out qp-wrong-line-size)
 
-(provide-signature-elements qp^)
+ ;; -- qp methods --
+ qp-encode
+ qp-decode
+ qp-encode-stream
+ qp-decode-stream)
+
+;; Exceptions:
+;; String or input-port expected:
+(define-struct qp-error ())
+(define-struct (qp-wrong-input qp-error) ())
+(define-struct (qp-wrong-line-size qp-error) (size))
+
+;; qp-encode : bytes -> bytes
+;; returns the quoted printable representation of STR.
+(define (qp-encode str)
+  (let ([out (open-output-bytes)])
+    (qp-encode-stream (open-input-bytes str) out #"\r\n")
+    (get-output-bytes out)))
+
+;; qp-decode : string -> string
+;; returns STR unqp.
+(define (qp-decode str)
+  (let ([out (open-output-bytes)])
+    (qp-decode-stream (open-input-bytes str) out)
+    (get-output-bytes out)))
+
+(define (qp-decode-stream in out)
+  (let loop ([ch (read-byte in)])
+    (unless (eof-object? ch)
+      (case ch
+        [(61) ;; A "=", which is quoted-printable stuff
+         (let ([next (read-byte in)])
+           (cond
+             [(eq? next 10)
+              ;; Soft-newline -- drop it
+              (void)]
+             [(eq? next 13)
+              ;; Expect a newline for a soft CRLF...
+              (let ([next-next (read-byte in)])
+                (if (eq? next-next 10)
+                  ;; Good.
+                  (loop (read-byte in))
+                  ;; Not a LF? Well, ok.
+                  (loop next-next)))]
+             [(hex-digit? next)
+              (let ([next-next (read-byte in)])
+                (cond [(eof-object? next-next)
+                       (warning "Illegal qp sequence: `=~a'" next)
+                       (display "=" out)
+                       (display next out)]
+                      [(hex-digit? next-next)
+                       ;; qp-encoded
+                       (write-byte (hex-bytes->byte next next-next)
+                                   out)]
+                      [else
+                       (warning "Illegal qp sequence: `=~a~a'" next next-next)
+                       (write-byte 61 out)
+                       (write-byte next out)
+                       (write-byte next-next out)]))]
+             [else
+              ;; Warning: invalid
+              (warning "Illegal qp sequence: `=~a'" next)
+              (write-byte 61 out)
+              (write-byte next out)])
+           (loop (read-byte in)))]
+        [else
+         (write-byte ch out)
+         (loop (read-byte in))]))))
+
+(define (warning msg . args)
+  (when #f
+    (fprintf (current-error-port)
+             (apply format msg args))
+    (newline (current-error-port))))
+
+(define (hex-digit? i)
+  (vector-ref hex-values i))
+
+(define (hex-bytes->byte b1 b2)
+  (+ (* 16 (vector-ref hex-values b1))
+     (vector-ref hex-values b2)))
+
+(define (write-hex-bytes byte p)
+  (write-byte 61 p)
+  (write-byte (vector-ref hex-bytes (arithmetic-shift byte -4)) p)
+  (write-byte (vector-ref hex-bytes (bitwise-and byte 15)) p))
+
+(define (qp-encode-stream in out [newline-string #"\n"])
+  (let loop ([col 0])
+    (if (= col 75)
+      (begin
+        ;; Soft newline:
+        (write-byte 61 out)
+        (display newline-string out)
+        (loop 0))
+      (let ([i (read-byte in)])
+        (cond
+          [(eof-object? i) (void)]
+          [(or (= i 10) (= i 13))
+           (write-byte i out)
+           (loop 0)]
+          [(or (<= 33 i 60) (<= 62 i 126)
+               (and (or (= i 32) (= i 9))
+                    (not (let ([next (peek-byte in)])
+                           (or (eof-object? next) (= next 10) (= next 13))))))
+           ;; single-byte mode:
+           (write-byte i out)
+           (loop (add1 col))]
+          [(>= col 73)
+           ;; need a soft newline first
+           (write-byte 61 out)
+           (display newline-string out)
+           ;; now the octect
+           (write-hex-bytes i out)
+           (loop 3)]
+          [else
+           ;; an octect
+           (write-hex-bytes i out)
+           (loop (+ col 3))])))))
+
+;; Tables
+(define hex-values (make-vector 256 #f))
+(define hex-bytes (make-vector 16))
+(let loop ([i 0])
+  (unless (= i 10)
+    (vector-set! hex-values (+ i 48) i)
+    (vector-set! hex-bytes i (+ i 48))
+    (loop (add1 i))))
+(let loop ([i 0])
+  (unless (= i 6)
+    (vector-set! hex-values (+ i 65) (+ 10 i))
+    (vector-set! hex-values (+ i 97) (+ 10 i))
+    (vector-set! hex-bytes (+ 10 i) (+ i 65))
+    (loop (add1 i))))
 
 ;;; qp.rkt ends here
diff --git a/collects/net/scribblings/base64.scrbl b/collects/net/scribblings/base64.scrbl
index 7d74db1fd6..0d3b6293ed 100644
--- a/collects/net/scribblings/base64.scrbl
+++ b/collects/net/scribblings/base64.scrbl
@@ -46,6 +46,10 @@ end-of-file or Base 64 terminator @litchar{=} from @racket[in].}
 
 @section{Base64 Unit}
 
+@margin-note{@racket[base64@] and @racket[base64^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/base64] module.}
+
 @defmodule[net/base64-unit]
 
 @defthing[base64@ unit?]{
diff --git a/collects/net/scribblings/cgi.scrbl b/collects/net/scribblings/cgi.scrbl
index 562d659d92..169ccef9b0 100644
--- a/collects/net/scribblings/cgi.scrbl
+++ b/collects/net/scribblings/cgi.scrbl
@@ -140,6 +140,10 @@ query is invalid.}
 
 @section{CGI Unit}
 
+@margin-note{@racket[cgi@] and @racket[cgi^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/cgi] module.}
+
 @defmodule[net/cgi-unit]
 
 @defthing[cgi@ unit?]{
diff --git a/collects/net/scribblings/dns.scrbl b/collects/net/scribblings/dns.scrbl
index 016a237413..552c59d202 100644
--- a/collects/net/scribblings/dns.scrbl
+++ b/collects/net/scribblings/dns.scrbl
@@ -56,6 +56,10 @@ extract the first nameserver address. On Windows, it runs
 
 @section{DNS Unit}
 
+@margin-note{@racket[dns@] and @racket[dns^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/dns] module.}
+
 @defmodule[net/dns-unit]
 
 @defthing[dns@ unit?]{
diff --git a/collects/net/scribblings/ftp.scrbl b/collects/net/scribblings/ftp.scrbl
index 7c8fc253db..1bbcaf0387 100644
--- a/collects/net/scribblings/ftp.scrbl
+++ b/collects/net/scribblings/ftp.scrbl
@@ -88,6 +88,10 @@ file, then moved into place on success).}
 
 @section{FTP Unit}
 
+@margin-note{@racket[ftp@] and @racket[ftp^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/ftp] module.}
+
 @defmodule[net/ftp-unit]
 
 @defthing[ftp@ unit?]{
diff --git a/collects/net/scribblings/head.scrbl b/collects/net/scribblings/head.scrbl
index d93cba84f0..440612e680 100644
--- a/collects/net/scribblings/head.scrbl
+++ b/collects/net/scribblings/head.scrbl
@@ -222,6 +222,10 @@ are comma-separated, and possibly broken into multiple lines.
 
 @section{Header Unit}
 
+@margin-note{@racket[head@] and @racket[head^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/head] module.}
+
 @defmodule[net/head-unit]
 
 @defthing[head@ unit?]{
diff --git a/collects/net/scribblings/imap.scrbl b/collects/net/scribblings/imap.scrbl
index e4f835a4d5..da85e9565d 100644
--- a/collects/net/scribblings/imap.scrbl
+++ b/collects/net/scribblings/imap.scrbl
@@ -497,6 +497,10 @@ Returns a list of IMAP flags for the given mailbox. See also
 
 @section{IMAP Unit}
 
+@margin-note{@racket[imap@] and @racket[imap^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/imap] module.}
+
 @defmodule[net/imap-unit]
 
 @defthing[imap@ unit?]{
diff --git a/collects/net/scribblings/mime.scrbl b/collects/net/scribblings/mime.scrbl
index 30b8c38026..f611e1e641 100644
--- a/collects/net/scribblings/mime.scrbl
+++ b/collects/net/scribblings/mime.scrbl
@@ -236,6 +236,10 @@ field, or when the specification is incorrectly formatted.}
 
 @section{MIME Unit}
 
+@margin-note{@racket[mime@] and @racket[mime^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/mime] module.}
+
 @defmodule[net/mime-unit]
 
 @defthing[mime@ unit?]{
diff --git a/collects/net/scribblings/nntp.scrbl b/collects/net/scribblings/nntp.scrbl
index d63ceca3c2..dbace6999d 100644
--- a/collects/net/scribblings/nntp.scrbl
+++ b/collects/net/scribblings/nntp.scrbl
@@ -135,6 +135,10 @@ Raised when the server reject an authentication attempt.}
 
 @section{NNTP Unit}
 
+@margin-note{@racket[nntp@] and @racket[nntp^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/nntp] module.}
+
 @defmodule[net/nntp-unit]
 
 @defthing[nntp@ unit?]{
diff --git a/collects/net/scribblings/pop3.scrbl b/collects/net/scribblings/pop3.scrbl
index 99b3669c32..9a78f86769 100644
--- a/collects/net/scribblings/pop3.scrbl
+++ b/collects/net/scribblings/pop3.scrbl
@@ -184,6 +184,10 @@ Raised when the server produces a malformed response.}
 
 @section{POP3 Unit}
 
+@margin-note{@racket[pop3@] and @racket[pop3^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/pop3] module.}
+
 @defmodule[net/pop3-unit]
 
 @defthing[pop3@ unit?]{
diff --git a/collects/net/scribblings/qp.scrbl b/collects/net/scribblings/qp.scrbl
index c5f0a6d608..18ef49e957 100644
--- a/collects/net/scribblings/qp.scrbl
+++ b/collects/net/scribblings/qp.scrbl
@@ -66,6 +66,10 @@ backward compatibility.}
 
 @section{Quoted-Printable Unit}
 
+@margin-note{@racket[qp@] and @racket[qp^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/qp] module.}
+
 @defmodule[net/qp-unit]
 
 @defthing[qp@ unit?]{
diff --git a/collects/net/scribblings/sendmail.scrbl b/collects/net/scribblings/sendmail.scrbl
index cef43caa42..d034f15662 100644
--- a/collects/net/scribblings/sendmail.scrbl
+++ b/collects/net/scribblings/sendmail.scrbl
@@ -63,6 +63,10 @@ Raised when no mail recipients were specified for
 
 @section{Sendmail Unit}
 
+@margin-note{@racket[sendmail@] and @racket[sendmail^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/sendmail] module.}
+
 @defmodule[net/sendmail-unit]
 
 @defthing[sendmail@ unit?]{
diff --git a/collects/net/scribblings/smtp.scrbl b/collects/net/scribblings/smtp.scrbl
index 46cc382838..a6f768f300 100644
--- a/collects/net/scribblings/smtp.scrbl
+++ b/collects/net/scribblings/smtp.scrbl
@@ -102,6 +102,10 @@ probably will not).}
 
 @section{SMTP Unit}
 
+@margin-note{@racket[smtp@] and @racket[smtp^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/smtp] module.}
+
 @defmodule[net/smtp-unit]
 
 @defthing[smtp@ unit?]{
diff --git a/collects/net/scribblings/uri-codec.scrbl b/collects/net/scribblings/uri-codec.scrbl
index 57f3c30ebc..17a8da688c 100644
--- a/collects/net/scribblings/uri-codec.scrbl
+++ b/collects/net/scribblings/uri-codec.scrbl
@@ -154,3 +154,27 @@ use/recognize only of the separators.
 (form-urlencoded->alist "x=foo;y=bar;z=baz")
 (alist->form-urlencoded ex)
 ]}
+
+@; ----------------------------------------
+
+@section{URI Codec Unit}
+
+@margin-note{@racket[uri-codec@] and @racket[uri-codec^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/uri-codec] module.}
+
+@defmodule[net/uri-codec-unit]
+
+@defthing[uri-codec@ unit?]{
+
+Imports nothing, exports @racket[uri-codec^].}
+
+@; ----------------------------------------
+
+@section{URI Codec Signature}
+
+@defmodule[net/uri-codec-sig]
+
+@defsignature[uri-codec^ ()]{}
+
+Includes everything exported by the @racketmodname[net/uri-codec] module.
diff --git a/collects/net/scribblings/url.scrbl b/collects/net/scribblings/url.scrbl
index ed8ca9b98b..e1b2db5f32 100644
--- a/collects/net/scribblings/url.scrbl
+++ b/collects/net/scribblings/url.scrbl
@@ -361,6 +361,10 @@ as described with @racket[get-pure-port].}
 
 @section{URL Unit}
 
+@margin-note{@racket[url@], @racket[url^], and @racket[url+scheme^] are deprecated.
+They exist for backward-compatibility and will likely be removed in
+the future. New code should use the @racketmodname[net/url] module.}
+
 @defmodule[net/url-unit]
 
 @defthing[url@ unit?]{
diff --git a/collects/net/sendmail-unit.rkt b/collects/net/sendmail-unit.rkt
index bca94df243..2fd97068e9 100644
--- a/collects/net/sendmail-unit.rkt
+++ b/collects/net/sendmail-unit.rkt
@@ -1,119 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/system "sendmail-sig.rkt")
+(require racket/unit
+         "sendmail-sig.rkt" "sendmail.rkt")
 
-(import)
-(export sendmail^)
+(define-unit-from-context sendmail@ sendmail^)
 
-(define-struct (no-mail-recipients exn) ())
-
-(define sendmail-search-path
-  '("/usr/lib" "/usr/sbin"))
-
-(define sendmail-program-file
-  (if (or (eq? (system-type) 'unix)
-          (eq? (system-type) 'macosx))
-    (let loop ([paths sendmail-search-path])
-      (if (null? paths)
-        (raise (make-exn:fail:unsupported
-                "unable to find sendmail on this Unix variant"
-                (current-continuation-marks)))
-        (let ([p (build-path (car paths) "sendmail")])
-          (if (and (file-exists? p)
-                   (memq 'execute (file-or-directory-permissions p)))
-            p
-            (loop (cdr paths))))))
-    (raise (make-exn:fail:unsupported
-            "sendmail only available under Unix"
-            (current-continuation-marks)))))
-
-;; send-mail-message/port :
-;; string x string x list (string) x list (string) x list (string)
-;;   [x list (string)] -> oport
-
-;; -- sender can be anything, though spoofing is not recommended.
-;; The recipients must all be pure email addresses.  Note that
-;; everything is expected to follow RFC conventions.  If any other
-;; headers are specified, they are expected to be completely
-;; formatted already.  Clients are urged to use close-output-port on
-;; the port returned by this procedure as soon as the necessary text
-;; has been written, so that the sendmail process can complete.
-
-(define (send-mail-message/port
-         sender subject to-recipients cc-recipients bcc-recipients
-         . other-headers)
-  (when (and (null? to-recipients) (null? cc-recipients)
-             (null? bcc-recipients))
-    (raise (make-no-mail-recipients
-            "no mail recipients were specified"
-            (current-continuation-marks))))
-  (let ([return (apply process* sendmail-program-file "-i"
-                       (append to-recipients cc-recipients bcc-recipients))])
-    (let ([reader (car return)]
-          [writer (cadr return)]
-          [pid (caddr return)]
-          [error-reader (cadddr return)])
-      (close-input-port reader)
-      (close-input-port error-reader)
-      (fprintf writer "From: ~a\n" sender)
-      (letrec ([write-recipient-header
-                (lambda (header-string recipients)
-                  (let ([header-space
-                         (+ (string-length header-string) 2)])
-                    (fprintf writer "~a: " header-string)
-                    (let loop ([to recipients] [indent header-space])
-                      (if (null? to)
-                        (newline writer)
-                        (let ([first (car to)]
-                              [rest (cdr to)])
-                          (let ([len (string-length first)])
-                            (if (>= (+ len indent) 80)
-                              (begin
-                                (fprintf writer
-                                         (if (null? rest)
-                                           "\n    ~a"
-                                           "\n    ~a, ")
-                                         first)
-                                (loop (cdr to)
-                                      (+ len header-space 2)))
-                              (begin
-                                (fprintf writer
-                                         (if (null? rest)
-                                           "~a "
-                                           "~a, ")
-                                         first)
-                                (loop (cdr to)
-                                      (+ len indent 2))))))))))])
-        (write-recipient-header "To" to-recipients)
-        (unless (null? cc-recipients)
-          (write-recipient-header "CC" cc-recipients)))
-      (fprintf writer "Subject: ~a\n" subject)
-      (fprintf writer "X-Mailer: Racket (racket-lang.org)\n")
-      (for-each (lambda (s)
-                  (display s writer)
-                  (newline writer))
-                other-headers)
-      (newline writer)
-      writer)))
-
-;; send-mail-message :
-;; string x string x list (string) x list (string) x list (string) x
-;;   list (string) [x list (string)] -> ()
-
-;; -- sender can be anything, though spoofing is not recommended.  The
-;; recipients must all be pure email addresses.  The text is expected
-;; to be pre-formatted.  Note that everything is expected to follow
-;; RFC conventions.  If any other headers are specified, they are
-;; expected to be completely formatted already.
-
-(define (send-mail-message
-         sender subject to-recipients cc-recipients bcc-recipients text
-         . other-headers)
-  (let ([writer (apply send-mail-message/port sender subject
-                       to-recipients cc-recipients bcc-recipients
-                       other-headers)])
-    (for-each (lambda (s)
-                (display s writer)      ; We use -i, so "." is not a problem
-                (newline writer))
-              text)
-    (close-output-port writer)))
+(provide sendmail@)
diff --git a/collects/net/sendmail.rkt b/collects/net/sendmail.rkt
index e759519616..025aec0454 100644
--- a/collects/net/sendmail.rkt
+++ b/collects/net/sendmail.rkt
@@ -1,6 +1,120 @@
 #lang racket/base
-(require racket/unit "sendmail-sig.rkt" "sendmail-unit.rkt")
 
-(define-values/invoke-unit/infer sendmail@)
+(require racket/system)
 
-(provide-signature-elements sendmail^)
+(provide send-mail-message/port
+         send-mail-message
+         (struct-out no-mail-recipients))
+
+(define-struct (no-mail-recipients exn) ())
+
+(define sendmail-search-path
+  '("/usr/lib" "/usr/sbin"))
+
+(define sendmail-program-file
+  (if (or (eq? (system-type) 'unix)
+          (eq? (system-type) 'macosx))
+    (let loop ([paths sendmail-search-path])
+      (if (null? paths)
+        (raise (make-exn:fail:unsupported
+                "unable to find sendmail on this Unix variant"
+                (current-continuation-marks)))
+        (let ([p (build-path (car paths) "sendmail")])
+          (if (and (file-exists? p)
+                   (memq 'execute (file-or-directory-permissions p)))
+            p
+            (loop (cdr paths))))))
+    (raise (make-exn:fail:unsupported
+            "sendmail only available under Unix"
+            (current-continuation-marks)))))
+
+;; send-mail-message/port :
+;; string x string x list (string) x list (string) x list (string)
+;;   [x list (string)] -> oport
+
+;; -- sender can be anything, though spoofing is not recommended.
+;; The recipients must all be pure email addresses.  Note that
+;; everything is expected to follow RFC conventions.  If any other
+;; headers are specified, they are expected to be completely
+;; formatted already.  Clients are urged to use close-output-port on
+;; the port returned by this procedure as soon as the necessary text
+;; has been written, so that the sendmail process can complete.
+
+(define (send-mail-message/port
+         sender subject to-recipients cc-recipients bcc-recipients
+         . other-headers)
+  (when (and (null? to-recipients) (null? cc-recipients)
+             (null? bcc-recipients))
+    (raise (make-no-mail-recipients
+            "no mail recipients were specified"
+            (current-continuation-marks))))
+  (let ([return (apply process* sendmail-program-file "-i"
+                       (append to-recipients cc-recipients bcc-recipients))])
+    (let ([reader (car return)]
+          [writer (cadr return)]
+          [pid (caddr return)]
+          [error-reader (cadddr return)])
+      (close-input-port reader)
+      (close-input-port error-reader)
+      (fprintf writer "From: ~a\n" sender)
+      (letrec ([write-recipient-header
+                (lambda (header-string recipients)
+                  (let ([header-space
+                         (+ (string-length header-string) 2)])
+                    (fprintf writer "~a: " header-string)
+                    (let loop ([to recipients] [indent header-space])
+                      (if (null? to)
+                        (newline writer)
+                        (let ([first (car to)]
+                              [rest (cdr to)])
+                          (let ([len (string-length first)])
+                            (if (>= (+ len indent) 80)
+                              (begin
+                                (fprintf writer
+                                         (if (null? rest)
+                                           "\n    ~a"
+                                           "\n    ~a, ")
+                                         first)
+                                (loop (cdr to)
+                                      (+ len header-space 2)))
+                              (begin
+                                (fprintf writer
+                                         (if (null? rest)
+                                           "~a "
+                                           "~a, ")
+                                         first)
+                                (loop (cdr to)
+                                      (+ len indent 2))))))))))])
+        (write-recipient-header "To" to-recipients)
+        (unless (null? cc-recipients)
+          (write-recipient-header "CC" cc-recipients)))
+      (fprintf writer "Subject: ~a\n" subject)
+      (fprintf writer "X-Mailer: Racket (racket-lang.org)\n")
+      (for-each (lambda (s)
+                  (display s writer)
+                  (newline writer))
+                other-headers)
+      (newline writer)
+      writer)))
+
+;; send-mail-message :
+;; string x string x list (string) x list (string) x list (string) x
+;;   list (string) [x list (string)] -> ()
+
+;; -- sender can be anything, though spoofing is not recommended.  The
+;; recipients must all be pure email addresses.  The text is expected
+;; to be pre-formatted.  Note that everything is expected to follow
+;; RFC conventions.  If any other headers are specified, they are
+;; expected to be completely formatted already.
+
+(define (send-mail-message
+         sender subject to-recipients cc-recipients bcc-recipients text
+         . other-headers)
+  (let ([writer (apply send-mail-message/port sender subject
+                       to-recipients cc-recipients bcc-recipients
+                       other-headers)])
+    (for-each (lambda (s)
+                (display s writer)      ; We use -i, so "." is not a problem
+                (newline writer))
+              text)
+    (close-output-port writer)))
diff --git a/collects/net/smtp-unit.rkt b/collects/net/smtp-unit.rkt
index fae6c4bc42..98adc51b2f 100644
--- a/collects/net/smtp-unit.rkt
+++ b/collects/net/smtp-unit.rkt
@@ -1,164 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/tcp "base64.rkt" "smtp-sig.rkt")
+(require racket/unit
+         "smtp-sig.rkt" "smtp.rkt")
 
-(import)
-(export smtp^)
+(define-unit-from-context smtp@ smtp^)
 
-(define smtp-sending-server (make-parameter "localhost"))
-
-(define debug-via-stdio? #f)
-
-;; (define log printf)
-(define log void)
-
-(define (starts-with? l n)
-  (and (>= (string-length l) (string-length n))
-       (string=? n (substring l 0 (string-length n)))))
-
-(define (check-reply/accum r v w a)
-  (flush-output w)
-  (let ([l (read-line r (if debug-via-stdio? 'linefeed 'return-linefeed))])
-    (log "server: ~a\n" l)
-    (if (eof-object? l)
-        (error 'check-reply "got EOF")
-        (let ([n (number->string v)])
-          (unless (starts-with? l n)
-            (error 'check-reply "expected reply ~a; got: ~a" v l))
-          (let ([n- (string-append n "-")])
-            (if (starts-with? l n-)
-                ;; Multi-line reply. Go again.
-                (check-reply/accum r v w (if a (cons (substring l 4) a) #f))
-                ;; We're finished, so add the last and reverse the result
-                (when a
-                  (reverse (cons (substring l 4) a)))))))))
-
-(define (check-reply/commands r v w . commands)
-  ;; drop the first response, which is just the flavor text -- we expect the rest to
-  ;; be a list of supported ESMTP commands.
-  (let ([cmdlist (cdr (check-reply/accum r v w '()))])
-    (for-each (lambda (c1)
-                (unless (findf (lambda (c2) (string=? c1 c2)) cmdlist)
-                  (error "expected advertisement of ESMTP command ~a" c1)))
-              commands)))
-
-(define (check-reply r v w)
-  (check-reply/accum r v w #f))
-
-(define (protect-line l)
-  ;; If begins with a dot, add one more
-  (if (or (equal? l #"")
-          (equal? l "")
-          (and (string? l)
-               (not (char=? #\. (string-ref l 0))))
-          (and (bytes? l)
-               (not (= (char->integer #\.) (bytes-ref l 0)))))
-      l
-      (if (bytes? l)
-          (bytes-append #"." l)
-          (string-append "." l))))
-
-(define smtp-sending-end-of-message
-  (make-parameter void
-                  (lambda (f)
-                    (unless (and (procedure? f)
-                                 (procedure-arity-includes? f 0))
-                      (raise-type-error 'smtp-sending-end-of-message "thunk" f))
-                    f)))
-
-(define (smtp-send-message* r w sender recipients header message-lines
-                            auth-user auth-passwd tls-encode)
-  (with-handlers ([void (lambda (x)
-                          (close-input-port r)
-                          (close-output-port w)
-                          (raise x))])
-    (check-reply r 220 w)
-    (log "hello\n")
-    (fprintf w "EHLO ~a\r\n" (smtp-sending-server))
-    (when tls-encode
-      (check-reply/commands r 250 w "STARTTLS")
-      (log "starttls\n")
-      (fprintf w "STARTTLS\r\n")
-      (check-reply r 220 w)
-      (let-values ([(ssl-r ssl-w)
-                    (tls-encode r w
-                                #:mode 'connect
-                                #:encrypt 'tls
-                                #:close-original? #t)])
-        (set! r ssl-r)
-        (set! w ssl-w))
-      ;; According to RFC 3207 Sec 4.2, we must start anew with the EHLO.
-      (log "tls hello\n")
-      (fprintf w "EHLO ~a\r\n" (smtp-sending-server)))
-    (check-reply r 250 w)
-
-    (when auth-user
-      (log "auth\n")
-      (fprintf w "AUTH PLAIN ~a"
-               ;; Encoding adds CRLF
-               (base64-encode
-                (string->bytes/latin-1
-                 (format "~a\0~a\0~a" auth-user auth-user auth-passwd))))
-      (check-reply r 235 w))
-
-    (log "from\n")
-    (fprintf w "MAIL FROM:<~a>\r\n" sender)
-    (check-reply r 250 w)
-
-    (log "to\n")
-    (for-each
-     (lambda (dest)
-       (fprintf w "RCPT TO:<~a>\r\n" dest)
-       (check-reply r 250 w))
-     recipients)
-
-    (log "header\n")
-    (fprintf w "DATA\r\n")
-    (check-reply r 354 w)
-    (fprintf w "~a" header)
-    (for-each
-     (lambda (l)
-       (log "body: ~a\n" l)
-       (fprintf w "~a\r\n" (protect-line l)))
-     message-lines)
-
-    ;; After we send the ".", then only break in an emergency
-    ((smtp-sending-end-of-message))
-
-    (log "dot\n")
-    (fprintf w ".\r\n")
-    (flush-output w)
-    (check-reply r 250 w)
-
-    ;; Once a 250 has been received in response to the . at the end of
-    ;; the DATA block, the email has been sent successfully and out of our
-    ;; hands.  This function should thus indicate success at this point
-    ;; no matter what else happens.
-    ;;
-    ;; Some servers (like smtp.gmail.com) will just close the connection
-    ;; on a QUIT, so instead of causing any QUIT errors to look like the
-    ;; email failed, we'll just log them.
-    (with-handlers ([void (lambda (x)
-                            (log "error after send: ~a\n" (exn-message x)))])
-      (log "quit\n")
-      (fprintf w "QUIT\r\n")
-      (check-reply r 221 w))
-
-    (close-output-port w)
-    (close-input-port r)))
-
-(define smtp-send-message
-  (lambda (server sender recipients header message-lines
-                  #:port-no [port-no 25]
-                  #:auth-user [auth-user #f]
-                  #:auth-passwd [auth-passwd #f]
-                  #:tcp-connect [tcp-connect tcp-connect]
-                  #:tls-encode [tls-encode #f]
-                  [opt-port-no port-no])
-    (when (null? recipients)
-      (error 'send-smtp-message "no receivers"))
-    (let-values ([(r w) (if debug-via-stdio?
-                            (values (current-input-port) (current-output-port))
-                            (tcp-connect server opt-port-no))])
-      (smtp-send-message* r w sender recipients header message-lines
-                          auth-user auth-passwd tls-encode))))
+(provide smtp@)
diff --git a/collects/net/smtp.rkt b/collects/net/smtp.rkt
index 4e213d4701..c635a4580b 100644
--- a/collects/net/smtp.rkt
+++ b/collects/net/smtp.rkt
@@ -1,6 +1,166 @@
 #lang racket/base
-(require racket/unit "smtp-sig.rkt" "smtp-unit.rkt")
 
-(define-values/invoke-unit/infer smtp@)
+(require racket/tcp "base64.rkt")
 
-(provide-signature-elements smtp^)
+(provide smtp-sending-server
+         smtp-send-message
+         smtp-send-message*
+         smtp-sending-end-of-message)
+
+(define smtp-sending-server (make-parameter "localhost"))
+
+(define debug-via-stdio? #f)
+
+;; (define log printf)
+(define log void)
+
+(define (starts-with? l n)
+  (and (>= (string-length l) (string-length n))
+       (string=? n (substring l 0 (string-length n)))))
+
+(define (check-reply/accum r v w a)
+  (flush-output w)
+  (let ([l (read-line r (if debug-via-stdio? 'linefeed 'return-linefeed))])
+    (log "server: ~a\n" l)
+    (if (eof-object? l)
+        (error 'check-reply "got EOF")
+        (let ([n (number->string v)])
+          (unless (starts-with? l n)
+            (error 'check-reply "expected reply ~a; got: ~a" v l))
+          (let ([n- (string-append n "-")])
+            (if (starts-with? l n-)
+                ;; Multi-line reply. Go again.
+                (check-reply/accum r v w (if a (cons (substring l 4) a) #f))
+                ;; We're finished, so add the last and reverse the result
+                (when a
+                  (reverse (cons (substring l 4) a)))))))))
+
+(define (check-reply/commands r v w . commands)
+  ;; drop the first response, which is just the flavor text -- we expect the rest to
+  ;; be a list of supported ESMTP commands.
+  (let ([cmdlist (cdr (check-reply/accum r v w '()))])
+    (for-each (lambda (c1)
+                (unless (findf (lambda (c2) (string=? c1 c2)) cmdlist)
+                  (error "expected advertisement of ESMTP command ~a" c1)))
+              commands)))
+
+(define (check-reply r v w)
+  (check-reply/accum r v w #f))
+
+(define (protect-line l)
+  ;; If begins with a dot, add one more
+  (if (or (equal? l #"")
+          (equal? l "")
+          (and (string? l)
+               (not (char=? #\. (string-ref l 0))))
+          (and (bytes? l)
+               (not (= (char->integer #\.) (bytes-ref l 0)))))
+      l
+      (if (bytes? l)
+          (bytes-append #"." l)
+          (string-append "." l))))
+
+(define smtp-sending-end-of-message
+  (make-parameter void
+                  (lambda (f)
+                    (unless (and (procedure? f)
+                                 (procedure-arity-includes? f 0))
+                      (raise-type-error 'smtp-sending-end-of-message "thunk" f))
+                    f)))
+
+(define (smtp-send-message* r w sender recipients header message-lines
+                            auth-user auth-passwd tls-encode)
+  (with-handlers ([void (lambda (x)
+                          (close-input-port r)
+                          (close-output-port w)
+                          (raise x))])
+    (check-reply r 220 w)
+    (log "hello\n")
+    (fprintf w "EHLO ~a\r\n" (smtp-sending-server))
+    (when tls-encode
+      (check-reply/commands r 250 w "STARTTLS")
+      (log "starttls\n")
+      (fprintf w "STARTTLS\r\n")
+      (check-reply r 220 w)
+      (let-values ([(ssl-r ssl-w)
+                    (tls-encode r w
+                                #:mode 'connect
+                                #:encrypt 'tls
+                                #:close-original? #t)])
+        (set! r ssl-r)
+        (set! w ssl-w))
+      ;; According to RFC 3207 Sec 4.2, we must start anew with the EHLO.
+      (log "tls hello\n")
+      (fprintf w "EHLO ~a\r\n" (smtp-sending-server)))
+    (check-reply r 250 w)
+
+    (when auth-user
+      (log "auth\n")
+      (fprintf w "AUTH PLAIN ~a"
+               ;; Encoding adds CRLF
+               (base64-encode
+                (string->bytes/latin-1
+                 (format "~a\0~a\0~a" auth-user auth-user auth-passwd))))
+      (check-reply r 235 w))
+
+    (log "from\n")
+    (fprintf w "MAIL FROM:<~a>\r\n" sender)
+    (check-reply r 250 w)
+
+    (log "to\n")
+    (for-each
+     (lambda (dest)
+       (fprintf w "RCPT TO:<~a>\r\n" dest)
+       (check-reply r 250 w))
+     recipients)
+
+    (log "header\n")
+    (fprintf w "DATA\r\n")
+    (check-reply r 354 w)
+    (fprintf w "~a" header)
+    (for-each
+     (lambda (l)
+       (log "body: ~a\n" l)
+       (fprintf w "~a\r\n" (protect-line l)))
+     message-lines)
+
+    ;; After we send the ".", then only break in an emergency
+    ((smtp-sending-end-of-message))
+
+    (log "dot\n")
+    (fprintf w ".\r\n")
+    (flush-output w)
+    (check-reply r 250 w)
+
+    ;; Once a 250 has been received in response to the . at the end of
+    ;; the DATA block, the email has been sent successfully and out of our
+    ;; hands.  This function should thus indicate success at this point
+    ;; no matter what else happens.
+    ;;
+    ;; Some servers (like smtp.gmail.com) will just close the connection
+    ;; on a QUIT, so instead of causing any QUIT errors to look like the
+    ;; email failed, we'll just log them.
+    (with-handlers ([void (lambda (x)
+                            (log "error after send: ~a\n" (exn-message x)))])
+      (log "quit\n")
+      (fprintf w "QUIT\r\n")
+      (check-reply r 221 w))
+
+    (close-output-port w)
+    (close-input-port r)))
+
+(define smtp-send-message
+  (lambda (server sender recipients header message-lines
+                  #:port-no [port-no 25]
+                  #:auth-user [auth-user #f]
+                  #:auth-passwd [auth-passwd #f]
+                  #:tcp-connect [tcp-connect tcp-connect]
+                  #:tls-encode [tls-encode #f]
+                  [opt-port-no port-no])
+    (when (null? recipients)
+      (error 'send-smtp-message "no receivers"))
+    (let-values ([(r w) (if debug-via-stdio?
+                            (values (current-input-port) (current-output-port))
+                            (tcp-connect server opt-port-no))])
+      (smtp-send-message* r w sender recipients header message-lines
+                          auth-user auth-passwd tls-encode))))
diff --git a/collects/net/uri-codec-unit.rkt b/collects/net/uri-codec-unit.rkt
index 42a2ff3148..f680d8ac12 100644
--- a/collects/net/uri-codec-unit.rkt
+++ b/collects/net/uri-codec-unit.rkt
@@ -1,290 +1,8 @@
-#|
+#lang racket/base
 
-People used to wonder why semicolons were the default.  We then
-decided to switch the default back to ampersands --
+(require racket/unit
+         "uri-codec-sig.rkt" "uri-codec.rkt")
 
-  http://www.w3.org/TR/html401/appendix/notes.html#h-B.2.2
+(define-unit-from-context uri-codec@ uri-codec^)
 
-  We recommend that HTTP server implementors, and in particular, CGI
-  implementors support the use of ";" in place of "&" to save authors
-  the trouble of escaping "&" characters in this manner.
-
-See more in PR8831.
-
-|#
-
-
-;;;
-;;; <uri-codec-unit.rkt> ---- En/Decode URLs and form-urlencoded data
-;;; Time-stamp: <03/04/25 10:31:31 noel>
-;;;
-;;; Copyright (C) 2002 by Noel Welsh.
-;;;
-;;; This file is part of Net.
-
-;;; Net is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Lesser General Public
-;;; License as published by the Free Software Foundation; either
-;;; version 2.1 of the License, or (at your option) any later version.
-
-;;; Net is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Lesser General Public License for more details.
-
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with Net; if not, write to the Free Software
-;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-;;; 02110-1301 USA.
-
-;;; Author: Noel Welsh <noelwelsh@yahoo.com>
-;;
-;;
-;; Commentary:
-
-;; The module provides functions to encode and decode strings using
-;; the URI encoding rules given in RFC 2396, and to encode and decode
-;; name/value pairs using the application/x-www-form-urlencoded
-;; mimetype given the in HTML 4.0 specification.  There are minor
-;; differences between the two encodings.
-
-;; The URI encoding uses allows a few characters to be represented `as
-;; is': a-Z, A-Z, 0-9, -, _, ., !, ~, *, ', ( and ).  The remaining
-;; characters are encoded as %xx, where xx is the hex representation
-;; of the integer value of the character (where the mapping
-;; character<->integer is determined by US-ASCII if the integer is
-;; <128).
-
-;; The encoding, inline with RFC 2396's recommendation, represents a
-;; character as is, if possible.  The decoding allows any characters
-;; to be represented by their hex values, and allows characters to be
-;; incorrectly represented `as is'.
-
-;; The rules for the application/x-www-form-urlencoded mimetype given
-;; in the HTML 4.0 spec are:
-
-;;   1. Control names and values are escaped. Space characters are
-;;   replaced by `+', and then reserved characters are escaped as
-;;   described in [RFC1738], section 2.2: Non-alphanumeric characters
-;;   are replaced by `%HH', a percent sign and two hexadecimal digits
-;;   representing the ASCII code of the character. Line breaks are
-;;   represented as "CR LF" pairs (i.e., `%0D%0A').
-
-;;   2. The control names/values are listed in the order they appear
-;;   in the document. The name is separated from the value by `=' and
-;;   name/value pairs are separated from each other by `&'.
-
-;; NB: RFC 2396 supersedes RFC 1738.
-
-;; This differs slightly from the straight encoding in RFC 2396 in
-;; that `+' is allowed, and represents a space.  We follow this
-;; convention, encoding a space as `+' and decoding `+' as a space.
-;; There appear to be some brain-dead decoders on the web, so we also
-;; encode `!', `~', `'', `(' and ')' using their hex representation.
-;; This is the same choice as made by the Java URLEncoder.
-
-;; Draws inspiration from encode-decode.scm by Kurt Normark and a code
-;; sample provided by Eli Barzilay
-
-#lang racket/unit
-
-(require racket/match racket/string racket/list "uri-codec-sig.rkt")
-
-(import)
-(export uri-codec^)
-
-(define (self-map-char ch) (cons ch ch))
-(define (self-map-chars str) (map self-map-char (string->list str)))
-
-;; The characters that always map to themselves
-(define alphanumeric-mapping
-  (self-map-chars
-   "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
-
-;; Characters that sometimes map to themselves
-;; called 'mark' in RFC 3986
-(define safe-mapping (self-map-chars "-_.!~*'()"))
-
-;; The strict URI mapping
-(define uri-mapping (append alphanumeric-mapping safe-mapping))
-
-;; The uri path segment mapping from RFC 3986
-(define uri-path-segment-mapping
-  (append alphanumeric-mapping
-          safe-mapping
-          (self-map-chars "@+,=$&:")))
-
-;; from RFC 3986
-(define unreserved-mapping
-  (append alphanumeric-mapping
-          (self-map-chars "-._~")))
-
-;; from RFC 3986
-(define sub-delims-mapping
-  (self-map-chars "!$&'()*+,;="))
-
-;; The uri userinfo mapping from RFC 3986
-(define uri-userinfo-mapping
-  (append unreserved-mapping
-          sub-delims-mapping
-          (self-map-chars ":")))
-
-;; The form-urlencoded mapping
-(define form-urlencoded-mapping
-  `(,@(self-map-chars ".-*_") (#\space . #\+) ,@alphanumeric-mapping))
-
-(define (number->hex-string number)
-  (define (hex n) (string-ref "0123456789ABCDEF" n))
-  (string #\% (hex (quotient number 16)) (hex (modulo number 16))))
-
-(define (hex-string->number hex-string)
-  (string->number (substring hex-string 1 3) 16))
-
-(define ascii-size 128)
-
-;; (listof (cons char char)) -> (values (vectorof string) (vectorof string))
-(define (make-codec-tables alist)
-  (let ([encoding-table (build-vector ascii-size number->hex-string)]
-        [decoding-table (build-vector ascii-size values)])
-    (for-each (match-lambda
-               [(cons orig enc)
-                (vector-set! encoding-table
-                             (char->integer orig)
-                             (string enc))
-                (vector-set! decoding-table
-                             (char->integer enc)
-                             (char->integer orig))])
-              alist)
-    (values encoding-table decoding-table)))
-
-(define-values (uri-encoding-vector uri-decoding-vector)
-  (make-codec-tables uri-mapping))
-
-(define-values (uri-path-segment-encoding-vector
-                uri-path-segment-decoding-vector)
-  (make-codec-tables uri-path-segment-mapping))
-
-(define-values (uri-userinfo-encoding-vector
-                uri-userinfo-decoding-vector)
-  (make-codec-tables uri-userinfo-mapping))
-
-
-(define-values (form-urlencoded-encoding-vector
-                form-urlencoded-decoding-vector)
-  (make-codec-tables form-urlencoded-mapping))
-
-;; vector string -> string
-(define (encode table str)
-  (apply string-append (map (lambda (byte)
-                              (if (< byte ascii-size)
-                                (vector-ref table byte)
-                                (number->hex-string byte)))
-                            (bytes->list (string->bytes/utf-8 str)))))
-
-;; vector string -> string
-(define (decode table str)
-  (define internal-decode
-    (match-lambda [(list) (list)]
-                  [(list* #\% (? hex-digit? char1) (? hex-digit? char2) rest)
-                   ;; This used to consult the table again, but I think that's
-                   ;;  wrong. For example %2b should produce +, not a space.
-                   (cons (string->number (string char1 char2) 16)
-                         (internal-decode rest))]
-                  [(cons (? ascii-char? char) rest)
-                   (cons (vector-ref table (char->integer char))
-                         (internal-decode rest))]
-                  [(cons char rest)
-                   (append
-                    (bytes->list (string->bytes/utf-8 (string char)))
-                    (internal-decode rest))]))
-  (bytes->string/utf-8 (apply bytes (internal-decode (string->list str)))))
-
-(define (ascii-char? c)
-  (< (char->integer c) ascii-size))
-
-(define (hex-digit? c)
-  (or (char<=? #\0 c #\9)
-      (char<=? #\a c #\f)
-      (char<=? #\A c #\F)))
-
-;; string -> string
-(define (uri-encode str)
-  (encode uri-encoding-vector str))
-
-;; string -> string
-(define (uri-decode str)
-  (decode uri-decoding-vector str))
-
-;; string -> string
-(define (uri-path-segment-encode str)
-  (encode uri-path-segment-encoding-vector str))
-
-;; string -> string
-(define (uri-path-segment-decode str)
-  (decode uri-path-segment-decoding-vector str))
-
-;; string -> string
-(define (uri-userinfo-encode str)
-  (encode uri-userinfo-encoding-vector str))
-
-;; string -> string
-(define (uri-userinfo-decode str)
-  (decode uri-userinfo-decoding-vector str))
-
-
-;; string -> string
-(define (form-urlencoded-encode str)
-  (encode form-urlencoded-encoding-vector str))
-
-;; string -> string
-(define (form-urlencoded-decode str)
-  (decode form-urlencoded-decoding-vector str))
-
-;; listof (cons string string) -> string
-;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
-;; listof (cons symbol string) -> string
-(define (alist->form-urlencoded args)
-  (let* ([sep (if (memq (current-alist-separator-mode) '(semi semi-or-amp))
-                ";" "&")]
-         [format-one
-          (lambda (arg)
-            (let* ([name  (car arg)]
-                   [value (cdr arg)]
-                   [name  (form-urlencoded-encode (symbol->string name))]
-                   [value (and value (form-urlencoded-encode value))])
-              (if value (string-append name "=" value) name)))]
-         [strs (if (null? args)
-                 '()
-                 (cons (format-one (car args))
-                       (apply append
-                              (map (lambda (a) (list sep (format-one a)))
-                                   (cdr args)))))])
-    (apply string-append strs)))
-
-;; string -> listof (cons string string)
-;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
-(define (form-urlencoded->alist str)
-  (define keyval-regexp #rx"=")
-  (define value-regexp
-    (case (current-alist-separator-mode)
-      [(semi) #rx"[;]"]
-      [(amp) #rx"[&]"]
-      [else #rx"[&;]"]))
-  (define (parse-keyval keyval)
-    (let (;; m = #f => no "=..." part
-          [m (regexp-match-positions keyval-regexp keyval)])
-      (cons (string->symbol (form-urlencoded-decode
-                             (if m (substring keyval 0 (caar m)) keyval)))
-            (and m (form-urlencoded-decode (substring keyval (cdar m)))))))
-  (if (equal? "" str) '() (map parse-keyval (regexp-split value-regexp str))))
-
-(define current-alist-separator-mode
-  (make-parameter 'amp-or-semi
-    (lambda (s)
-      (unless (memq s '(amp semi amp-or-semi semi-or-amp))
-        (raise-type-error 'current-alist-separator-mode
-                          "'amp, 'semi, 'amp-or-semi, or 'semi-or-amp"
-                          s))
-      s)))
-
-;;; uri-codec-unit.rkt ends here
+(provide uri-codec@)
diff --git a/collects/net/uri-codec.rkt b/collects/net/uri-codec.rkt
index 2ab56b22d8..7c0c53ae64 100644
--- a/collects/net/uri-codec.rkt
+++ b/collects/net/uri-codec.rkt
@@ -1,6 +1,294 @@
 #lang racket/base
-(require racket/unit "uri-codec-sig.rkt" "uri-codec-unit.rkt")
 
-(provide-signature-elements uri-codec^)
+#|
+People used to wonder why semicolons were the default.  We then
+decided to switch the default back to ampersands --
 
-(define-values/invoke-unit/infer uri-codec@)
+  http://www.w3.org/TR/html401/appendix/notes.html#h-B.2.2
+
+  We recommend that HTTP server implementors, and in particular, CGI
+  implementors support the use of ";" in place of "&" to save authors
+  the trouble of escaping "&" characters in this manner.
+
+See more in PR8831.
+|#
+
+;;; <uri-codec.rkt> ---- En/Decode URLs and form-urlencoded data
+;;; Time-stamp: <03/04/25 10:31:31 noel>
+;;;
+;;; Copyright (C) 2002 by Noel Welsh.
+;;;
+;;; This file is part of Net.
+
+;;; Net is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2.1 of the License, or (at your option) any later version.
+
+;;; Net is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with Net; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;;; 02110-1301 USA.
+
+;;; Author: Noel Welsh <noelwelsh@yahoo.com>
+;;
+;; Commentary:
+
+;; The module provides functions to encode and decode strings using
+;; the URI encoding rules given in RFC 2396, and to encode and decode
+;; name/value pairs using the application/x-www-form-urlencoded
+;; mimetype given the in HTML 4.0 specification.  There are minor
+;; differences between the two encodings.
+
+;; The URI encoding uses allows a few characters to be represented `as
+;; is': a-Z, A-Z, 0-9, -, _, ., !, ~, *, ', ( and ).  The remaining
+;; characters are encoded as %xx, where xx is the hex representation
+;; of the integer value of the character (where the mapping
+;; character<->integer is determined by US-ASCII if the integer is
+;; <128).
+
+;; The encoding, inline with RFC 2396's recommendation, represents a
+;; character as is, if possible.  The decoding allows any characters
+;; to be represented by their hex values, and allows characters to be
+;; incorrectly represented `as is'.
+
+;; The rules for the application/x-www-form-urlencoded mimetype given
+;; in the HTML 4.0 spec are:
+
+;;   1. Control names and values are escaped. Space characters are
+;;   replaced by `+', and then reserved characters are escaped as
+;;   described in [RFC1738], section 2.2: Non-alphanumeric characters
+;;   are replaced by `%HH', a percent sign and two hexadecimal digits
+;;   representing the ASCII code of the character. Line breaks are
+;;   represented as "CR LF" pairs (i.e., `%0D%0A').
+
+;;   2. The control names/values are listed in the order they appear
+;;   in the document. The name is separated from the value by `=' and
+;;   name/value pairs are separated from each other by `&'.
+
+;; NB: RFC 2396 supersedes RFC 1738.
+
+;; This differs slightly from the straight encoding in RFC 2396 in
+;; that `+' is allowed, and represents a space.  We follow this
+;; convention, encoding a space as `+' and decoding `+' as a space.
+;; There appear to be some brain-dead decoders on the web, so we also
+;; encode `!', `~', `'', `(' and ')' using their hex representation.
+;; This is the same choice as made by the Java URLEncoder.
+
+;; Draws inspiration from encode-decode.scm by Kurt Normark and a code
+;; sample provided by Eli Barzilay
+
+(require racket/match racket/string racket/list)
+
+(provide uri-encode
+         uri-decode
+         uri-path-segment-encode
+         uri-path-segment-decode
+         uri-userinfo-encode
+         uri-userinfo-decode
+         form-urlencoded-encode
+         form-urlencoded-decode
+         alist->form-urlencoded
+         form-urlencoded->alist
+         current-alist-separator-mode)
+
+(define (self-map-char ch) (cons ch ch))
+(define (self-map-chars str) (map self-map-char (string->list str)))
+
+;; The characters that always map to themselves
+(define alphanumeric-mapping
+  (self-map-chars
+   "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
+
+;; Characters that sometimes map to themselves
+;; called 'mark' in RFC 3986
+(define safe-mapping (self-map-chars "-_.!~*'()"))
+
+;; The strict URI mapping
+(define uri-mapping (append alphanumeric-mapping safe-mapping))
+
+;; The uri path segment mapping from RFC 3986
+(define uri-path-segment-mapping
+  (append alphanumeric-mapping
+          safe-mapping
+          (self-map-chars "@+,=$&:")))
+
+;; from RFC 3986
+(define unreserved-mapping
+  (append alphanumeric-mapping
+          (self-map-chars "-._~")))
+
+;; from RFC 3986
+(define sub-delims-mapping
+  (self-map-chars "!$&'()*+,;="))
+
+;; The uri userinfo mapping from RFC 3986
+(define uri-userinfo-mapping
+  (append unreserved-mapping
+          sub-delims-mapping
+          (self-map-chars ":")))
+
+;; The form-urlencoded mapping
+(define form-urlencoded-mapping
+  `(,@(self-map-chars ".-*_") (#\space . #\+) ,@alphanumeric-mapping))
+
+(define (number->hex-string number)
+  (define (hex n) (string-ref "0123456789ABCDEF" n))
+  (string #\% (hex (quotient number 16)) (hex (modulo number 16))))
+
+(define (hex-string->number hex-string)
+  (string->number (substring hex-string 1 3) 16))
+
+(define ascii-size 128)
+
+;; (listof (cons char char)) -> (values (vectorof string) (vectorof string))
+(define (make-codec-tables alist)
+  (let ([encoding-table (build-vector ascii-size number->hex-string)]
+        [decoding-table (build-vector ascii-size values)])
+    (for-each (match-lambda
+               [(cons orig enc)
+                (vector-set! encoding-table
+                             (char->integer orig)
+                             (string enc))
+                (vector-set! decoding-table
+                             (char->integer enc)
+                             (char->integer orig))])
+              alist)
+    (values encoding-table decoding-table)))
+
+(define-values (uri-encoding-vector uri-decoding-vector)
+  (make-codec-tables uri-mapping))
+
+(define-values (uri-path-segment-encoding-vector
+                uri-path-segment-decoding-vector)
+  (make-codec-tables uri-path-segment-mapping))
+
+(define-values (uri-userinfo-encoding-vector
+                uri-userinfo-decoding-vector)
+  (make-codec-tables uri-userinfo-mapping))
+
+
+(define-values (form-urlencoded-encoding-vector
+                form-urlencoded-decoding-vector)
+  (make-codec-tables form-urlencoded-mapping))
+
+;; vector string -> string
+(define (encode table str)
+  (apply string-append (map (lambda (byte)
+                              (if (< byte ascii-size)
+                                (vector-ref table byte)
+                                (number->hex-string byte)))
+                            (bytes->list (string->bytes/utf-8 str)))))
+
+;; vector string -> string
+(define (decode table str)
+  (define internal-decode
+    (match-lambda [(list) (list)]
+                  [(list* #\% (? hex-digit? char1) (? hex-digit? char2) rest)
+                   ;; This used to consult the table again, but I think that's
+                   ;;  wrong. For example %2b should produce +, not a space.
+                   (cons (string->number (string char1 char2) 16)
+                         (internal-decode rest))]
+                  [(cons (? ascii-char? char) rest)
+                   (cons (vector-ref table (char->integer char))
+                         (internal-decode rest))]
+                  [(cons char rest)
+                   (append
+                    (bytes->list (string->bytes/utf-8 (string char)))
+                    (internal-decode rest))]))
+  (bytes->string/utf-8 (apply bytes (internal-decode (string->list str)))))
+
+(define (ascii-char? c)
+  (< (char->integer c) ascii-size))
+
+(define (hex-digit? c)
+  (or (char<=? #\0 c #\9)
+      (char<=? #\a c #\f)
+      (char<=? #\A c #\F)))
+
+;; string -> string
+(define (uri-encode str)
+  (encode uri-encoding-vector str))
+
+;; string -> string
+(define (uri-decode str)
+  (decode uri-decoding-vector str))
+
+;; string -> string
+(define (uri-path-segment-encode str)
+  (encode uri-path-segment-encoding-vector str))
+
+;; string -> string
+(define (uri-path-segment-decode str)
+  (decode uri-path-segment-decoding-vector str))
+
+;; string -> string
+(define (uri-userinfo-encode str)
+  (encode uri-userinfo-encoding-vector str))
+
+;; string -> string
+(define (uri-userinfo-decode str)
+  (decode uri-userinfo-decoding-vector str))
+
+
+;; string -> string
+(define (form-urlencoded-encode str)
+  (encode form-urlencoded-encoding-vector str))
+
+;; string -> string
+(define (form-urlencoded-decode str)
+  (decode form-urlencoded-decoding-vector str))
+
+;; listof (cons string string) -> string
+;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
+;; listof (cons symbol string) -> string
+(define (alist->form-urlencoded args)
+  (let* ([sep (if (memq (current-alist-separator-mode) '(semi semi-or-amp))
+                ";" "&")]
+         [format-one
+          (lambda (arg)
+            (let* ([name  (car arg)]
+                   [value (cdr arg)]
+                   [name  (form-urlencoded-encode (symbol->string name))]
+                   [value (and value (form-urlencoded-encode value))])
+              (if value (string-append name "=" value) name)))]
+         [strs (if (null? args)
+                 '()
+                 (cons (format-one (car args))
+                       (apply append
+                              (map (lambda (a) (list sep (format-one a)))
+                                   (cdr args)))))])
+    (apply string-append strs)))
+
+;; string -> listof (cons string string)
+;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
+(define (form-urlencoded->alist str)
+  (define keyval-regexp #rx"=")
+  (define value-regexp
+    (case (current-alist-separator-mode)
+      [(semi) #rx"[;]"]
+      [(amp) #rx"[&]"]
+      [else #rx"[&;]"]))
+  (define (parse-keyval keyval)
+    (let (;; m = #f => no "=..." part
+          [m (regexp-match-positions keyval-regexp keyval)])
+      (cons (string->symbol (form-urlencoded-decode
+                             (if m (substring keyval 0 (caar m)) keyval)))
+            (and m (form-urlencoded-decode (substring keyval (cdar m)))))))
+  (if (equal? "" str) '() (map parse-keyval (regexp-split value-regexp str))))
+
+(define current-alist-separator-mode
+  (make-parameter 'amp-or-semi
+    (lambda (s)
+      (unless (memq s '(amp semi amp-or-semi semi-or-amp))
+        (raise-type-error 'current-alist-separator-mode
+                          "'amp, 'semi, 'amp-or-semi, or 'semi-or-amp"
+                          s))
+      s)))
+
+;;; uri-codec.rkt ends here
diff --git a/collects/net/url-connect.rkt b/collects/net/url-connect.rkt
new file mode 100644
index 0000000000..5f80bb4188
--- /dev/null
+++ b/collects/net/url-connect.rkt
@@ -0,0 +1,24 @@
+#lang racket/base
+
+(require (rename-in racket/tcp
+                    [tcp-connect plain-tcp-connect]
+                    [tcp-abandon-port plain-tcp-abandon-port])
+         openssl)
+
+(provide (all-defined-out))
+
+(define current-connect-scheme (make-parameter "http"))
+
+(define current-https-protocol (make-parameter 'sslv2-or-v3))
+
+;; Define `tcp-connect' and `tcp-abandon-port' to fit with
+;; `current-connect-scheme'
+(define (tcp-connect host port)
+  (cond [(equal? (current-connect-scheme) "https")
+         (ssl-connect host port (current-https-protocol))]
+        [else
+         (plain-tcp-connect host port)]))
+
+(define (tcp-abandon-port port)
+  (cond [(ssl-port? port) (ssl-abandon-port port)]
+        [else (plain-tcp-abandon-port port)]))
diff --git a/collects/net/url-unit.rkt b/collects/net/url-unit.rkt
index a4b4acbb59..98fe4d33dc 100644
--- a/collects/net/url-unit.rkt
+++ b/collects/net/url-unit.rkt
@@ -1,608 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-;; To do:
-;;   Handle HTTP/file errors.
-;;   Not throw away MIME headers.
-;;     Determine file type.
+(require racket/unit
+         "url-sig.rkt" "url.rkt" "url-connect.rkt")
 
-;; ----------------------------------------------------------------------
+(define-unit-from-context url@ url+scheme^)
 
-;; Input ports have two statuses:
-;;   "impure" = they have text waiting
-;;   "pure" = the MIME headers have been read
-
-(require racket/port racket/string
-         "url-structs.rkt" "uri-codec.rkt" "url-sig.rkt" "tcp-sig.rkt")
-
-(import tcp^)
-(export url+scheme^)
-
-(define-struct (url-exception exn:fail) ())
-
-(define file-url-path-convention-type (make-parameter (system-path-convention-type)))
-
-(define current-proxy-servers
-  (make-parameter null
-    (lambda (v)
-      (unless (and (list? v)
-                   (andmap (lambda (v)
-                             (and (list? v)
-                                  (= 3 (length v))
-                                  (equal? (car v) "http")
-                                  (string? (car v))
-                                  (exact-integer? (caddr v))
-                                  (<= 1 (caddr v) 65535)))
-                           v))
-        (raise-type-error
-         'current-proxy-servers
-         "list of list of scheme, string, and exact integer in [1,65535]"
-         v))
-      (map (lambda (v)
-             (list (string->immutable-string (car v))
-                   (string->immutable-string (cadr v))
-                   (caddr v)))
-           v))))
-
-(define (url-error fmt . args)
-  (raise (make-url-exception
-          (apply format fmt
-                 (map (lambda (arg) (if (url? arg) (url->string arg) arg))
-                      args))
-          (current-continuation-marks))))
-
-(define (url->string url)
-  (let ([scheme (url-scheme url)]
-        [user   (url-user url)]
-        [host   (url-host url)]
-        [port   (url-port url)]
-        [path   (url-path url)]
-        [query  (url-query url)]
-        [fragment (url-fragment url)]
-        [sa string-append])
-    (when (and (equal? scheme "file")
-               (not (url-path-absolute? url)))
-      (raise-mismatch-error 'url->string
-                            "cannot convert relative file URL to a string: "
-                            url))
-    (sa (if scheme (sa scheme ":") "")
-        (if (or user host port)
-          (sa "//"
-              (if user (sa (uri-userinfo-encode user) "@") "")
-              (if host host "")
-              (if port (sa ":" (number->string port)) "")
-              ;; There used to be a "/" here, but that causes an
-              ;; extra leading slash -- wonder why it ever worked!
-              )
-          (if (equal? "file" scheme) ; always need "//" for "file" URLs
-            "//"
-            ""))
-        (combine-path-strings (url-path-absolute? url) path)
-        ;; (if query (sa "?" (uri-encode query)) "")
-        (if (null? query) "" (sa "?" (alist->form-urlencoded query)))
-        (if fragment (sa "#" (uri-encode fragment)) ""))))
-
-;; url->default-port : url -> num
-(define (url->default-port url)
-  (let ([scheme (url-scheme url)])
-    (cond [(not scheme) 80]
-          [(string=? scheme "http") 80]
-          [(string=? scheme "https") 443]
-          [else (url-error "URL scheme ~s not supported" scheme)])))
-
-(define current-connect-scheme (make-parameter "http"))
-
-;; make-ports : url -> in-port x out-port
-(define (make-ports url proxy)
-  (let ([port-number (if proxy
-                       (caddr proxy)
-                       (or (url-port url) (url->default-port url)))]
-        [host (if proxy (cadr proxy) (url-host url))])
-    (parameterize ([current-connect-scheme (url-scheme url)])
-      (tcp-connect host port-number))))
-
-;; http://getpost-impure-port : bool x url x union (str, #f) x list (str) -> in-port
-(define (http://getpost-impure-port get? url post-data strings)
-  (define proxy (assoc (url-scheme url) (current-proxy-servers)))
-  (define-values (server->client client->server) (make-ports url proxy))
-  (define access-string
-    (url->string
-     (if proxy
-       url
-       ;; RFCs 1945 and 2616 say:
-       ;;   Note that the absolute path cannot be empty; if none is present in
-       ;;   the original URI, it must be given as "/" (the server root).
-       (let-values ([(abs? path)
-                     (if (null? (url-path url))
-                       (values #t (list (make-path/param "" '())))
-                       (values (url-path-absolute? url) (url-path url)))])
-         (make-url #f #f #f #f abs? path (url-query url) (url-fragment url))))))
-  (define (println . xs)
-    (for-each (lambda (x) (display x client->server)) xs)
-    (display "\r\n" client->server))
-  (println (if get? "GET " "POST ") access-string " HTTP/1.0")
-  (println "Host: " (url-host url)
-           (let ([p (url-port url)]) (if p (format ":~a" p) "")))
-  (when post-data (println "Content-Length: " (bytes-length post-data)))
-  (for-each println strings)
-  (println)
-  (when post-data (display post-data client->server))
-  (flush-output client->server)
-  (tcp-abandon-port client->server)
-  server->client)
-
-(define (file://->path url [kind (system-path-convention-type)])
-  (let ([strs (map path/param-path (url-path url))]
-        [string->path-element/same
-         (lambda (e)
-           (if (symbol? e)
-             e
-             (if (string=? e "")
-               'same
-               (bytes->path-element (string->bytes/locale e) kind))))]
-        [string->path/win (lambda (s)
-                            (bytes->path (string->bytes/utf-8 s) 'windows))])
-    (if (and (url-path-absolute? url)
-             (eq? 'windows kind))
-      ;; If initial path is "", then build UNC path.
-      (cond
-        [(not (url-path-absolute? url))
-         (apply build-path (map string->path-element/same strs))]
-        [(and ((length strs) . >= . 3)
-              (equal? (car strs) ""))
-         (apply build-path
-                (string->path/win
-                 (string-append "\\\\" (cadr strs) "\\" (caddr strs) "\\"))
-                (map string->path-element/same (cdddr strs)))]
-        [(pair? strs)
-         (apply build-path (string->path/win (car strs))
-                (map string->path-element/same (cdr strs)))]
-        [else (error 'file://->path "no path elements: ~e" url)])
-      (let ([elems (map string->path-element/same strs)])
-        (if (url-path-absolute? url)
-          (apply build-path (bytes->path #"/" 'unix) elems)
-          (apply build-path elems))))))
-
-;; file://get-pure-port : url -> in-port
-(define (file://get-pure-port url)
-  (open-input-file (file://->path url)))
-
-(define (schemeless-url url)
-  (url-error "Missing protocol (usually \"http:\") at the beginning of URL: ~a" url))
-
-;; getpost-impure-port : bool x url x list (str) -> in-port
-(define (getpost-impure-port get? url post-data strings)
-  (let ([scheme (url-scheme url)])
-    (cond [(not scheme)
-           (schemeless-url url)]
-          [(or (string=? scheme "http") (string=? scheme "https"))
-           (http://getpost-impure-port get? url post-data strings)]
-          [(string=? scheme "file")
-           (url-error "There are no impure file: ports")]
-          [else (url-error "Scheme ~a unsupported" scheme)])))
-
-;; get-impure-port : url [x list (str)] -> in-port
-(define (get-impure-port url [strings '()])
-  (getpost-impure-port #t url #f strings))
-
-;; post-impure-port : url x bytes [x list (str)] -> in-port
-(define (post-impure-port url post-data [strings '()])
-  (getpost-impure-port #f url post-data strings))
-
-;; getpost-pure-port : bool x url x list (str) -> in-port
-(define (getpost-pure-port get? url post-data strings)
-  (let ([scheme (url-scheme url)])
-    (cond [(not scheme)
-           (schemeless-url url)]
-          [(or (string=? scheme "http")
-               (string=? scheme "https"))
-           (let ([port (http://getpost-impure-port
-                        get? url post-data strings)])
-             (purify-http-port port))]
-          [(string=? scheme "file")
-           (file://get-pure-port url)]
-          [else (url-error "Scheme ~a unsupported" scheme)])))
-
-;; get-pure-port : url [x list (str)] -> in-port
-(define (get-pure-port url [strings '()])
-  (getpost-pure-port #t url #f strings))
-
-;; post-pure-port : url bytes [x list (str)] -> in-port
-(define (post-pure-port url post-data [strings '()])
-  (getpost-pure-port #f url post-data strings))
-
-;; display-pure-port : in-port -> ()
-(define (display-pure-port server->client)
-  (copy-port server->client (current-output-port))
-  (close-input-port server->client))
-
-;; transliteration of code in rfc 3986, section 5.2.2
-(define (combine-url/relative Base string)
-  (let ([R (string->url string)]
-        [T (make-url #f #f #f #f #f '() '() #f)])
-    (if (url-scheme R)
-      (begin
-        (set-url-scheme! T (url-scheme R))
-        (set-url-user! T (url-user R))  ;; authority
-        (set-url-host! T (url-host R))  ;; authority
-        (set-url-port! T (url-port R))  ;; authority
-        (set-url-path-absolute?! T (url-path-absolute? R))
-        (set-url-path! T (remove-dot-segments (url-path R)))
-        (set-url-query! T (url-query R)))
-      (begin
-        (if (url-host R)  ;; => authority is defined
-          (begin
-            (set-url-user! T (url-user R))  ;; authority
-            (set-url-host! T (url-host R))  ;; authority
-            (set-url-port! T (url-port R))  ;; authority
-            (set-url-path-absolute?! T (url-path-absolute? R))
-            (set-url-path! T (remove-dot-segments (url-path R)))
-            (set-url-query! T (url-query R)))
-          (begin
-            (if (null? (url-path R)) ;; => R has empty path
-              (begin
-                (set-url-path-absolute?! T (url-path-absolute? Base))
-                (set-url-path! T (url-path Base))
-                (if (not (null? (url-query R)))
-                  (set-url-query! T (url-query R))
-                  (set-url-query! T (url-query Base))))
-              (begin
-                (cond
-                  [(url-path-absolute? R)
-                   (set-url-path-absolute?! T #t)
-                   (set-url-path! T (remove-dot-segments (url-path R)))]
-                  [(and (null? (url-path Base))
-                        (url-host Base))
-                   (set-url-path-absolute?! T #t)
-                   (set-url-path! T (remove-dot-segments (url-path R)))]
-                  [else
-                   (set-url-path-absolute?! T (url-path-absolute? Base))
-                   (set-url-path! T (remove-dot-segments
-                                     (append (all-but-last (url-path Base))
-                                             (url-path R))))])
-                (set-url-query! T (url-query R))))
-            (set-url-user! T (url-user Base))   ;; authority
-            (set-url-host! T (url-host Base))   ;; authority
-            (set-url-port! T (url-port Base)))) ;; authority
-        (set-url-scheme! T (url-scheme Base))))
-    (set-url-fragment! T (url-fragment R))
-    T))
-
-(define (all-but-last lst)
-  (cond [(null? lst) null]
-        [(null? (cdr lst)) null]
-        [else (cons (car lst) (all-but-last (cdr lst)))]))
-
-;; cribbed from 5.2.4 in rfc 3986
-;; the strange [*] cases implicitly change urls
-;; with paths segments "." and ".." at the end
-;; into "./" and "../" respectively
-(define (remove-dot-segments path)
-  (let loop ([path path] [result '()])
-    (if (null? path)
-      (reverse result)
-      (let ([fst (path/param-path (car path))]
-            [rst (cdr path)])
-        (loop rst
-              (cond
-                [(and (eq? fst 'same) (null? rst))
-                 (cons (make-path/param "" '()) result)] ; [*]
-                [(eq? fst 'same)
-                 result]
-                [(and (eq? fst 'up) (null? rst) (not (null? result)))
-                 (cons (make-path/param "" '()) (cdr result))] ; [*]
-                [(and (eq? fst 'up) (not (null? result)))
-                 (cdr result)]
-                [(and (eq? fst 'up) (null? result))
-                 ;; when we go up too far, just drop the "up"s.
-                 result]
-                [else
-                 (cons (car path) result)]))))))
-
-;; call/input-url : url x (url -> in-port) x (in-port -> T)
-;;                  [x list (str)] -> T
-(define call/input-url
-  (let ([handle-port
-         (lambda (server->client handler)
-           (dynamic-wind (lambda () 'do-nothing)
-             (lambda () (handler server->client))
-             (lambda () (close-input-port server->client))))])
-    (case-lambda
-      [(url getter handler)
-       (handle-port (getter url) handler)]
-      [(url getter handler params)
-       (handle-port (getter url params) handler)])))
-
-;; purify-port : in-port -> header-string
-(define (purify-port port)
-  (let ([m (regexp-match-peek-positions
-            #rx"^HTTP/.*?(?:\r\n\r\n|\n\n|\r\r)" port)])
-    (if m (read-string (cdar m) port) "")))
-
-;; purify-http-port : in-port -> in-port
-;; returns a new port, closes the old one when done pumping
-(define (purify-http-port in-port)
-  (define-values (in-pipe out-pipe) (make-pipe))
-  (thread
-   (λ ()
-     (define status (http-read-status in-port))
-     (define chunked? (http-read-headers in-port))
-     (http-pipe-data chunked? in-port out-pipe)
-     (close-input-port in-port)))
-  in-pipe)
-
-(define (http-read-status ip)
-  (read-line ip 'return-linefeed))
-
-(define (http-read-headers ip)
-  (define l (read-line ip 'return-linefeed))
-  (when (eof-object? l)
-    (error 'purify-http-port "Connection ended before headers ended"))
-  (if (string=? l "")
-      #f
-      (if (string=? l "Transfer-Encoding: chunked")
-          (begin (http-read-headers ip)
-                 #t)
-          (http-read-headers ip))))
-
-(define (http-pipe-data chunked? ip op)
-  (if chunked?
-      (http-pipe-chunk ip op)
-      (begin
-        (copy-port ip op)
-        (flush-output op)
-        (close-output-port op))))
-
-(define (http-pipe-chunk ip op)
-  (define size-str (read-line ip 'return-linefeed))
-  (define chunk-size (string->number size-str 16))
-  (unless chunk-size
-    (error 'http-pipe-chunk "Could not parse ~S as hexadecimal number" size-str))
-  (if (zero? chunk-size)
-      (begin (flush-output op)
-             (close-output-port op))
-      (let* ([bs (read-bytes chunk-size ip)]
-             [crlf (read-bytes 2 ip)])
-        (write-bytes bs op)
-        (http-pipe-chunk ip op))))
-
-(define character-set-size 256)
-
-;; netscape/string->url : str -> url
-(define (netscape/string->url string)
-  (let ([url (string->url string)])
-    (cond [(url-scheme url) url]
-          [(string=? string "")
-           (url-error "Can't resolve empty string as URL")]
-          [else (set-url-scheme! url
-                  (if (char=? (string-ref string 0) #\/) "file" "http"))
-                url])))
-
-;; URL parsing regexp
-;; this is following the regexp in Appendix B of rfc 3986, except for using
-;; `*' instead of `+' for the scheme part (it is checked later anyway, and
-;; we don't want to parse it as a path element), and the user@host:port is
-;; parsed here.
-(define url-rx
-  (regexp (string-append
-           "^"
-           "(?:"              ; / scheme-colon-opt
-           "([^:/?#]*)"       ; | #1 = scheme-opt
-           ":)?"              ; \
-           "(?://"            ; / slash-slash-authority-opt
-           "(?:"              ; | / user-at-opt
-           "([^/?#@]*)"       ; | | #2 = user-opt
-           "@)?"              ; | \
-           "([^/?#:]*)?"      ; | #3 = host-opt
-           "(?::"             ; | / colon-port-opt
-           "([0-9]*)"         ; | | #4 = port-opt
-           ")?"               ; | \
-           ")?"               ; \
-           "([^?#]*)"         ; #5 = path
-           "(?:\\?"           ; / question-query-opt
-           "([^#]*)"          ; | #6 = query-opt
-           ")?"               ; \
-           "(?:#"             ; / hash-fragment-opt
-           "(.*)"             ; | #7 = fragment-opt
-           ")?"               ; \
-           "$")))
-
-;; string->url : str -> url
-;; Original version by Neil Van Dyke
-(define (string->url str)
-  (apply
-   (lambda (scheme user host port path query fragment)
-     (when (and scheme (not (regexp-match? #rx"^[a-zA-Z][a-zA-Z0-9+.-]*$"
-                                           scheme)))
-       (url-error "Invalid URL string; bad scheme ~e: ~e" scheme str))
-     ;; Windows => "file://xxx:/...." specifies a "xxx:/..." path
-     (let ([win-file? (and (or (equal? "" port) (not port))
-                           (equal? "file" scheme)
-                           (eq? 'windows (file-url-path-convention-type))
-                           (not (equal? host "")))])
-       (when win-file?
-         (set! path (cond [(equal? "" port) (string-append host ":" path)]
-                          [(and path host) (string-append host "/" path)]
-                          [else (or path host)]))
-         (set! port #f)
-         (set! host ""))
-       (let* ([scheme   (and scheme (string-downcase scheme))]
-              [host     (and host (string-downcase host))]
-              [user     (uri-decode/maybe user)]
-              [port     (and port (string->number port))]
-              [abs?     (or (equal? "file" scheme)
-                            (regexp-match? #rx"^/" path))]
-              [path     (if win-file?
-                          (separate-windows-path-strings path)
-                          (separate-path-strings path))]
-              [query    (if query (form-urlencoded->alist query) '())]
-              [fragment (uri-decode/maybe fragment)])
-         (make-url scheme user host port abs? path query fragment))))
-   (cdr (or (regexp-match url-rx str)
-            (url-error "Invalid URL string: ~e" str)))))
-
-(define (uri-decode/maybe f) (friendly-decode/maybe f uri-decode))
-
-(define (friendly-decode/maybe f uri-decode)
-  ;; If #f, and leave unmolested any % that is followed by hex digit
-  ;; if a % is not followed by a hex digit, replace it with %25
-  ;; in an attempt to be "friendly"
-  (and f (uri-decode (regexp-replace* #rx"%([^0-9a-fA-F])" f "%25\\1"))))
-
-;; separate-path-strings : string[starting with /] -> (listof path/param)
-(define (separate-path-strings str)
-  (let ([strs (regexp-split #rx"/" str)])
-    (map separate-params (if (string=? "" (car strs)) (cdr strs) strs))))
-
-(define (separate-windows-path-strings str)
-  (url-path (path->url (bytes->path (string->bytes/utf-8 str) 'windows))))
-
-(define (separate-params s)
-  (let ([lst (map path-segment-decode (regexp-split #rx";" s))])
-    (make-path/param (car lst) (cdr lst))))
-
-(define (path-segment-decode p)
-  (cond [(string=? p "..") 'up]
-        [(string=? p ".") 'same]
-        [else (uri-path-segment-decode p)]))
-
-(define (path-segment-encode p)
-  (cond [(eq?    p 'up)   ".."]
-        [(eq?    p 'same) "."]
-        [(equal? p "..")  "%2e%2e"]
-        [(equal? p ".")   "%2e"]
-        [else (uri-path-segment-encode p)]))
-
-(define (combine-path-strings absolute? path/params)
-  (cond [(null? path/params) ""]
-        [else (let ([p (string-join (map join-params path/params) "/")])
-                (if absolute? (string-append "/" p) p))]))
-
-(define (join-params s)
-  (string-join (map path-segment-encode
-                    (cons (path/param-path s) (path/param-param s)))
-               ";"))
-
-(define (path->url path)
-  (let ([url-path
-         (let loop ([path (simplify-path path #f)][accum null])
-           (let-values ([(base name dir?) (split-path path)])
-             (cond
-               [(not base)
-                (append (map
-                         (lambda (s)
-                           (make-path/param s null))
-                         (if (eq? (path-convention-type path) 'windows)
-                           ;; For Windows, massage the root:
-                           (let ([s (regexp-replace
-                                     #rx"[/\\\\]$"
-                                     (bytes->string/utf-8 (path->bytes name))
-                                     "")])
-                             (cond
-                               [(regexp-match? #rx"^\\\\\\\\[?]\\\\[a-zA-Z]:" s)
-                                ;; \\?\<drive>: path:
-                                (regexp-split #rx"[/\\]+" (substring s 4))]
-                               [(regexp-match? #rx"^\\\\\\\\[?]\\\\UNC" s)
-                                ;; \\?\ UNC path:
-                                (regexp-split #rx"[/\\]+" (substring s 7))]
-                               [(regexp-match? #rx"^[/\\]" s)
-                                ;; UNC path:
-                                (regexp-split #rx"[/\\]+" s)]
-                               [else
-                                (list s)]))
-                           ;; On other platforms, we drop the root:
-                           null))
-                        accum)]
-               [else
-                (let ([accum (cons (make-path/param 
-                                    (if (symbol? name)
-                                      name
-                                      (bytes->string/utf-8
-                                       (path-element->bytes name)))
-                                    null)
-                                   accum)])
-                  (if (eq? base 'relative)
-                    accum
-                    (loop base accum)))])))])
-    (make-url "file" #f "" #f (absolute-path? path) url-path '() #f)))
-
-(define (url->path url [kind (system-path-convention-type)])
-  (file://->path url kind))
-
-;; delete-pure-port : url [x list (str)] -> in-port
-(define (delete-pure-port url [strings '()])
-  (method-pure-port 'delete url #f strings))
-
-;; delete-impure-port : url [x list (str)] -> in-port
-(define (delete-impure-port url [strings '()])
-  (method-impure-port 'delete url #f strings))
-
-;; head-pure-port : url [x list (str)] -> in-port
-(define (head-pure-port url [strings '()])
-  (method-pure-port 'head url #f strings))
-
-;; head-impure-port : url [x list (str)] -> in-port
-(define (head-impure-port url [strings '()])
-  (method-impure-port 'head url #f strings))
-
-;; put-pure-port : url bytes [x list (str)] -> in-port
-(define (put-pure-port url put-data [strings '()])
-  (method-pure-port 'put url put-data strings))
-
-;; put-impure-port : url x bytes [x list (str)] -> in-port
-(define (put-impure-port url put-data [strings '()])
-  (method-impure-port 'put url put-data strings))
-
-;; method-impure-port : symbol x url x list (str) -> in-port
-(define (method-impure-port method url data strings)
-  (let ([scheme (url-scheme url)])
-    (cond [(not scheme)
-           (schemeless-url url)]
-          [(or (string=? scheme "http") (string=? scheme "https"))
-           (http://method-impure-port method url data strings)]
-          [(string=? scheme "file")
-           (url-error "There are no impure file: ports")]
-          [else (url-error "Scheme ~a unsupported" scheme)])))
-
-;; method-pure-port : symbol x url x list (str) -> in-port
-(define (method-pure-port method url data strings)
-  (let ([scheme (url-scheme url)])
-    (cond [(not scheme)
-           (schemeless-url url)]
-          [(or (string=? scheme "http") (string=? scheme "https"))
-           (let ([port (http://method-impure-port
-                        method url data strings)])
-             (purify-http-port port))]
-          [(string=? scheme "file")
-           (file://get-pure-port url)]
-          [else (url-error "Scheme ~a unsupported" scheme)])))
-
-;; http://metod-impure-port : symbol x url x union (str, #f) x list (str) -> in-port
-(define (http://method-impure-port method url data strings)
-  (let*-values
-      ([(method) (case method
-                   [(get) "GET"] [(post) "POST"] [(head) "HEAD"]
-                   [(put) "PUT"] [(delete) "DELETE"]
-                   [else (url-error "unsupported method: ~a" method)])]
-       [(proxy) (assoc (url-scheme url) (current-proxy-servers))]
-       [(server->client client->server) (make-ports url proxy)]
-       [(access-string) (url->string
-                         (if proxy
-                           url
-                           (make-url #f #f #f #f
-                                     (url-path-absolute? url)
-                                     (url-path url)
-                                     (url-query url)
-                                     (url-fragment url))))])
-    (define (println . xs)
-      (for-each (lambda (x) (display x client->server)) xs)
-      (display "\r\n" client->server))
-    (println method " " access-string " HTTP/1.0")
-    (println "Host: " (url-host url)
-             (let ([p (url-port url)]) (if p (format ":~a" p) "")))
-    (when data (println "Content-Length: " (bytes-length data)))
-    (for-each println strings)
-    (println)
-    (when data (display data client->server))
-    (flush-output client->server)
-    (tcp-abandon-port client->server)
-    server->client))
+(provide url@)
diff --git a/collects/net/url.rkt b/collects/net/url.rkt
index 7ceea392c4..d2afbc9d8b 100644
--- a/collects/net/url.rkt
+++ b/collects/net/url.rkt
@@ -1,39 +1,610 @@
 #lang racket/base
-(require racket/unit racket/contract
-         (rename-in racket/tcp 
-                    [tcp-connect plain-tcp-connect]
-                    [tcp-abandon-port plain-tcp-abandon-port])
-         openssl
-         "tcp-sig.rkt"
-         "url-structs.rkt" "url-sig.rkt" "url-unit.rkt")
+(require racket/unit racket/port racket/string racket/contract
+         "url-connect.rkt"
+         "url-structs.rkt"
+         "uri-codec.rkt")
 
-;; Define `tcp-connect' and `tcp-abandon-port' to fit with
-;; `current-connect-scheme' from `url-unt@'
-(define (tcp-connect host port)
-  (cond
-   [(equal? (current-connect-scheme) "https") 
-    (ssl-connect host port (current-https-protocol))]
-   [else 
-    (plain-tcp-connect host port)]))
+;; To do:
+;;   Handle HTTP/file errors.
+;;   Not throw away MIME headers.
+;;     Determine file type.
 
-(define (tcp-abandon-port port)
-  (cond
-   [(ssl-port? port) (ssl-abandon-port port)]
-   [else (plain-tcp-abandon-port port)]))
+;; ----------------------------------------------------------------------
 
-(define-unit-from-context tcp@ tcp^)
+;; Input ports have two statuses:
+;;   "impure" = they have text waiting
+;;   "pure" = the MIME headers have been read
 
-(define-compound-unit/infer url+tcp@
-  (import) (export url^)
-  (link tcp@ url@))
+(define-struct (url-exception exn:fail) ())
 
-(define-values/invoke-unit/infer url+tcp@)
+(define file-url-path-convention-type (make-parameter (system-path-convention-type)))
+
+(define current-proxy-servers
+  (make-parameter null
+    (lambda (v)
+      (unless (and (list? v)
+                   (andmap (lambda (v)
+                             (and (list? v)
+                                  (= 3 (length v))
+                                  (equal? (car v) "http")
+                                  (string? (car v))
+                                  (exact-integer? (caddr v))
+                                  (<= 1 (caddr v) 65535)))
+                           v))
+        (raise-type-error
+         'current-proxy-servers
+         "list of list of scheme, string, and exact integer in [1,65535]"
+         v))
+      (map (lambda (v)
+             (list (string->immutable-string (car v))
+                   (string->immutable-string (cadr v))
+                   (caddr v)))
+           v))))
+
+(define (url-error fmt . args)
+  (raise (make-url-exception
+          (apply format fmt
+                 (map (lambda (arg) (if (url? arg) (url->string arg) arg))
+                      args))
+          (current-continuation-marks))))
+
+(define (url->string url)
+  (let ([scheme (url-scheme url)]
+        [user   (url-user url)]
+        [host   (url-host url)]
+        [port   (url-port url)]
+        [path   (url-path url)]
+        [query  (url-query url)]
+        [fragment (url-fragment url)]
+        [sa string-append])
+    (when (and (equal? scheme "file")
+               (not (url-path-absolute? url)))
+      (raise-mismatch-error 'url->string
+                            "cannot convert relative file URL to a string: "
+                            url))
+    (sa (if scheme (sa scheme ":") "")
+        (if (or user host port)
+          (sa "//"
+              (if user (sa (uri-userinfo-encode user) "@") "")
+              (if host host "")
+              (if port (sa ":" (number->string port)) "")
+              ;; There used to be a "/" here, but that causes an
+              ;; extra leading slash -- wonder why it ever worked!
+              )
+          (if (equal? "file" scheme) ; always need "//" for "file" URLs
+            "//"
+            ""))
+        (combine-path-strings (url-path-absolute? url) path)
+        ;; (if query (sa "?" (uri-encode query)) "")
+        (if (null? query) "" (sa "?" (alist->form-urlencoded query)))
+        (if fragment (sa "#" (uri-encode fragment)) ""))))
+
+;; url->default-port : url -> num
+(define (url->default-port url)
+  (let ([scheme (url-scheme url)])
+    (cond [(not scheme) 80]
+          [(string=? scheme "http") 80]
+          [(string=? scheme "https") 443]
+          [else (url-error "URL scheme ~s not supported" scheme)])))
+
+;; make-ports : url -> in-port x out-port
+(define (make-ports url proxy)
+  (let ([port-number (if proxy
+                       (caddr proxy)
+                       (or (url-port url) (url->default-port url)))]
+        [host (if proxy (cadr proxy) (url-host url))])
+    (parameterize ([current-connect-scheme (url-scheme url)])
+      (tcp-connect host port-number))))
+
+;; http://getpost-impure-port : bool x url x union (str, #f) x list (str) -> in-port
+(define (http://getpost-impure-port get? url post-data strings)
+  (define proxy (assoc (url-scheme url) (current-proxy-servers)))
+  (define-values (server->client client->server) (make-ports url proxy))
+  (define access-string
+    (url->string
+     (if proxy
+       url
+       ;; RFCs 1945 and 2616 say:
+       ;;   Note that the absolute path cannot be empty; if none is present in
+       ;;   the original URI, it must be given as "/" (the server root).
+       (let-values ([(abs? path)
+                     (if (null? (url-path url))
+                       (values #t (list (make-path/param "" '())))
+                       (values (url-path-absolute? url) (url-path url)))])
+         (make-url #f #f #f #f abs? path (url-query url) (url-fragment url))))))
+  (define (println . xs)
+    (for-each (lambda (x) (display x client->server)) xs)
+    (display "\r\n" client->server))
+  (println (if get? "GET " "POST ") access-string " HTTP/1.0")
+  (println "Host: " (url-host url)
+           (let ([p (url-port url)]) (if p (format ":~a" p) "")))
+  (when post-data (println "Content-Length: " (bytes-length post-data)))
+  (for-each println strings)
+  (println)
+  (when post-data (display post-data client->server))
+  (flush-output client->server)
+  (tcp-abandon-port client->server)
+  server->client)
+
+(define (file://->path url [kind (system-path-convention-type)])
+  (let ([strs (map path/param-path (url-path url))]
+        [string->path-element/same
+         (lambda (e)
+           (if (symbol? e)
+             e
+             (if (string=? e "")
+               'same
+               (bytes->path-element (string->bytes/locale e) kind))))]
+        [string->path/win (lambda (s)
+                            (bytes->path (string->bytes/utf-8 s) 'windows))])
+    (if (and (url-path-absolute? url)
+             (eq? 'windows kind))
+      ;; If initial path is "", then build UNC path.
+      (cond
+        [(not (url-path-absolute? url))
+         (apply build-path (map string->path-element/same strs))]
+        [(and ((length strs) . >= . 3)
+              (equal? (car strs) ""))
+         (apply build-path
+                (string->path/win
+                 (string-append "\\\\" (cadr strs) "\\" (caddr strs) "\\"))
+                (map string->path-element/same (cdddr strs)))]
+        [(pair? strs)
+         (apply build-path (string->path/win (car strs))
+                (map string->path-element/same (cdr strs)))]
+        [else (error 'file://->path "no path elements: ~e" url)])
+      (let ([elems (map string->path-element/same strs)])
+        (if (url-path-absolute? url)
+          (apply build-path (bytes->path #"/" 'unix) elems)
+          (apply build-path elems))))))
+
+;; file://get-pure-port : url -> in-port
+(define (file://get-pure-port url)
+  (open-input-file (file://->path url)))
+
+(define (schemeless-url url)
+  (url-error "Missing protocol (usually \"http:\") at the beginning of URL: ~a" url))
+
+;; getpost-impure-port : bool x url x list (str) -> in-port
+(define (getpost-impure-port get? url post-data strings)
+  (let ([scheme (url-scheme url)])
+    (cond [(not scheme)
+           (schemeless-url url)]
+          [(or (string=? scheme "http") (string=? scheme "https"))
+           (http://getpost-impure-port get? url post-data strings)]
+          [(string=? scheme "file")
+           (url-error "There are no impure file: ports")]
+          [else (url-error "Scheme ~a unsupported" scheme)])))
+
+;; get-impure-port : url [x list (str)] -> in-port
+(define (get-impure-port url [strings '()])
+  (getpost-impure-port #t url #f strings))
+
+;; post-impure-port : url x bytes [x list (str)] -> in-port
+(define (post-impure-port url post-data [strings '()])
+  (getpost-impure-port #f url post-data strings))
+
+;; getpost-pure-port : bool x url x list (str) -> in-port
+(define (getpost-pure-port get? url post-data strings)
+  (let ([scheme (url-scheme url)])
+    (cond [(not scheme)
+           (schemeless-url url)]
+          [(or (string=? scheme "http")
+               (string=? scheme "https"))
+           (let ([port (http://getpost-impure-port
+                        get? url post-data strings)])
+             (purify-http-port port))]
+          [(string=? scheme "file")
+           (file://get-pure-port url)]
+          [else (url-error "Scheme ~a unsupported" scheme)])))
+
+;; get-pure-port : url [x list (str)] -> in-port
+(define (get-pure-port url [strings '()])
+  (getpost-pure-port #t url #f strings))
+
+;; post-pure-port : url bytes [x list (str)] -> in-port
+(define (post-pure-port url post-data [strings '()])
+  (getpost-pure-port #f url post-data strings))
+
+;; display-pure-port : in-port -> ()
+(define (display-pure-port server->client)
+  (copy-port server->client (current-output-port))
+  (close-input-port server->client))
+
+;; transliteration of code in rfc 3986, section 5.2.2
+(define (combine-url/relative Base string)
+  (let ([R (string->url string)]
+        [T (make-url #f #f #f #f #f '() '() #f)])
+    (if (url-scheme R)
+      (begin
+        (set-url-scheme! T (url-scheme R))
+        (set-url-user! T (url-user R))  ;; authority
+        (set-url-host! T (url-host R))  ;; authority
+        (set-url-port! T (url-port R))  ;; authority
+        (set-url-path-absolute?! T (url-path-absolute? R))
+        (set-url-path! T (remove-dot-segments (url-path R)))
+        (set-url-query! T (url-query R)))
+      (begin
+        (if (url-host R)  ;; => authority is defined
+          (begin
+            (set-url-user! T (url-user R))  ;; authority
+            (set-url-host! T (url-host R))  ;; authority
+            (set-url-port! T (url-port R))  ;; authority
+            (set-url-path-absolute?! T (url-path-absolute? R))
+            (set-url-path! T (remove-dot-segments (url-path R)))
+            (set-url-query! T (url-query R)))
+          (begin
+            (if (null? (url-path R)) ;; => R has empty path
+              (begin
+                (set-url-path-absolute?! T (url-path-absolute? Base))
+                (set-url-path! T (url-path Base))
+                (if (not (null? (url-query R)))
+                  (set-url-query! T (url-query R))
+                  (set-url-query! T (url-query Base))))
+              (begin
+                (cond
+                  [(url-path-absolute? R)
+                   (set-url-path-absolute?! T #t)
+                   (set-url-path! T (remove-dot-segments (url-path R)))]
+                  [(and (null? (url-path Base))
+                        (url-host Base))
+                   (set-url-path-absolute?! T #t)
+                   (set-url-path! T (remove-dot-segments (url-path R)))]
+                  [else
+                   (set-url-path-absolute?! T (url-path-absolute? Base))
+                   (set-url-path! T (remove-dot-segments
+                                     (append (all-but-last (url-path Base))
+                                             (url-path R))))])
+                (set-url-query! T (url-query R))))
+            (set-url-user! T (url-user Base))   ;; authority
+            (set-url-host! T (url-host Base))   ;; authority
+            (set-url-port! T (url-port Base)))) ;; authority
+        (set-url-scheme! T (url-scheme Base))))
+    (set-url-fragment! T (url-fragment R))
+    T))
+
+(define (all-but-last lst)
+  (cond [(null? lst) null]
+        [(null? (cdr lst)) null]
+        [else (cons (car lst) (all-but-last (cdr lst)))]))
+
+;; cribbed from 5.2.4 in rfc 3986
+;; the strange [*] cases implicitly change urls
+;; with paths segments "." and ".." at the end
+;; into "./" and "../" respectively
+(define (remove-dot-segments path)
+  (let loop ([path path] [result '()])
+    (if (null? path)
+      (reverse result)
+      (let ([fst (path/param-path (car path))]
+            [rst (cdr path)])
+        (loop rst
+              (cond
+                [(and (eq? fst 'same) (null? rst))
+                 (cons (make-path/param "" '()) result)] ; [*]
+                [(eq? fst 'same)
+                 result]
+                [(and (eq? fst 'up) (null? rst) (not (null? result)))
+                 (cons (make-path/param "" '()) (cdr result))] ; [*]
+                [(and (eq? fst 'up) (not (null? result)))
+                 (cdr result)]
+                [(and (eq? fst 'up) (null? result))
+                 ;; when we go up too far, just drop the "up"s.
+                 result]
+                [else
+                 (cons (car path) result)]))))))
+
+;; call/input-url : url x (url -> in-port) x (in-port -> T)
+;;                  [x list (str)] -> T
+(define call/input-url
+  (let ([handle-port
+         (lambda (server->client handler)
+           (dynamic-wind (lambda () 'do-nothing)
+             (lambda () (handler server->client))
+             (lambda () (close-input-port server->client))))])
+    (case-lambda
+      [(url getter handler)
+       (handle-port (getter url) handler)]
+      [(url getter handler params)
+       (handle-port (getter url params) handler)])))
+
+;; purify-port : in-port -> header-string
+(define (purify-port port)
+  (let ([m (regexp-match-peek-positions
+            #rx"^HTTP/.*?(?:\r\n\r\n|\n\n|\r\r)" port)])
+    (if m (read-string (cdar m) port) "")))
+
+;; purify-http-port : in-port -> in-port
+;; returns a new port, closes the old one when done pumping
+(define (purify-http-port in-port)
+  (define-values (in-pipe out-pipe) (make-pipe))
+  (thread
+   (λ ()
+     (define status (http-read-status in-port))
+     (define chunked? (http-read-headers in-port))
+     (http-pipe-data chunked? in-port out-pipe)
+     (close-input-port in-port)))
+  in-pipe)
+
+(define (http-read-status ip)
+  (read-line ip 'return-linefeed))
+
+(define (http-read-headers ip)
+  (define l (read-line ip 'return-linefeed))
+  (when (eof-object? l)
+    (error 'purify-http-port "Connection ended before headers ended"))
+  (if (string=? l "")
+      #f
+      (if (string=? l "Transfer-Encoding: chunked")
+          (begin (http-read-headers ip)
+                 #t)
+          (http-read-headers ip))))
+
+(define (http-pipe-data chunked? ip op)
+  (if chunked?
+      (http-pipe-chunk ip op)
+      (begin
+        (copy-port ip op)
+        (flush-output op)
+        (close-output-port op))))
+
+(define (http-pipe-chunk ip op)
+  (define size-str (read-line ip 'return-linefeed))
+  (define chunk-size (string->number size-str 16))
+  (unless chunk-size
+    (error 'http-pipe-chunk "Could not parse ~S as hexadecimal number" size-str))
+  (if (zero? chunk-size)
+      (begin (flush-output op)
+             (close-output-port op))
+      (let* ([bs (read-bytes chunk-size ip)]
+             [crlf (read-bytes 2 ip)])
+        (write-bytes bs op)
+        (http-pipe-chunk ip op))))
+
+(define character-set-size 256)
+
+;; netscape/string->url : str -> url
+(define (netscape/string->url string)
+  (let ([url (string->url string)])
+    (cond [(url-scheme url) url]
+          [(string=? string "")
+           (url-error "Can't resolve empty string as URL")]
+          [else (set-url-scheme! url
+                  (if (char=? (string-ref string 0) #\/) "file" "http"))
+                url])))
+
+;; URL parsing regexp
+;; this is following the regexp in Appendix B of rfc 3986, except for using
+;; `*' instead of `+' for the scheme part (it is checked later anyway, and
+;; we don't want to parse it as a path element), and the user@host:port is
+;; parsed here.
+(define url-rx
+  (regexp (string-append
+           "^"
+           "(?:"              ; / scheme-colon-opt
+           "([^:/?#]*)"       ; | #1 = scheme-opt
+           ":)?"              ; \
+           "(?://"            ; / slash-slash-authority-opt
+           "(?:"              ; | / user-at-opt
+           "([^/?#@]*)"       ; | | #2 = user-opt
+           "@)?"              ; | \
+           "([^/?#:]*)?"      ; | #3 = host-opt
+           "(?::"             ; | / colon-port-opt
+           "([0-9]*)"         ; | | #4 = port-opt
+           ")?"               ; | \
+           ")?"               ; \
+           "([^?#]*)"         ; #5 = path
+           "(?:\\?"           ; / question-query-opt
+           "([^#]*)"          ; | #6 = query-opt
+           ")?"               ; \
+           "(?:#"             ; / hash-fragment-opt
+           "(.*)"             ; | #7 = fragment-opt
+           ")?"               ; \
+           "$")))
+
+;; string->url : str -> url
+;; Original version by Neil Van Dyke
+(define (string->url str)
+  (apply
+   (lambda (scheme user host port path query fragment)
+     (when (and scheme (not (regexp-match? #rx"^[a-zA-Z][a-zA-Z0-9+.-]*$"
+                                           scheme)))
+       (url-error "Invalid URL string; bad scheme ~e: ~e" scheme str))
+     ;; Windows => "file://xxx:/...." specifies a "xxx:/..." path
+     (let ([win-file? (and (or (equal? "" port) (not port))
+                           (equal? "file" scheme)
+                           (eq? 'windows (file-url-path-convention-type))
+                           (not (equal? host "")))])
+       (when win-file?
+         (set! path (cond [(equal? "" port) (string-append host ":" path)]
+                          [(and path host) (string-append host "/" path)]
+                          [else (or path host)]))
+         (set! port #f)
+         (set! host ""))
+       (let* ([scheme   (and scheme (string-downcase scheme))]
+              [host     (and host (string-downcase host))]
+              [user     (uri-decode/maybe user)]
+              [port     (and port (string->number port))]
+              [abs?     (or (equal? "file" scheme)
+                            (regexp-match? #rx"^/" path))]
+              [path     (if win-file?
+                          (separate-windows-path-strings path)
+                          (separate-path-strings path))]
+              [query    (if query (form-urlencoded->alist query) '())]
+              [fragment (uri-decode/maybe fragment)])
+         (make-url scheme user host port abs? path query fragment))))
+   (cdr (or (regexp-match url-rx str)
+            (url-error "Invalid URL string: ~e" str)))))
+
+(define (uri-decode/maybe f) (friendly-decode/maybe f uri-decode))
+
+(define (friendly-decode/maybe f uri-decode)
+  ;; If #f, and leave unmolested any % that is followed by hex digit
+  ;; if a % is not followed by a hex digit, replace it with %25
+  ;; in an attempt to be "friendly"
+  (and f (uri-decode (regexp-replace* #rx"%([^0-9a-fA-F])" f "%25\\1"))))
+
+;; separate-path-strings : string[starting with /] -> (listof path/param)
+(define (separate-path-strings str)
+  (let ([strs (regexp-split #rx"/" str)])
+    (map separate-params (if (string=? "" (car strs)) (cdr strs) strs))))
+
+(define (separate-windows-path-strings str)
+  (url-path (path->url (bytes->path (string->bytes/utf-8 str) 'windows))))
+
+(define (separate-params s)
+  (let ([lst (map path-segment-decode (regexp-split #rx";" s))])
+    (make-path/param (car lst) (cdr lst))))
+
+(define (path-segment-decode p)
+  (cond [(string=? p "..") 'up]
+        [(string=? p ".") 'same]
+        [else (uri-path-segment-decode p)]))
+
+(define (path-segment-encode p)
+  (cond [(eq?    p 'up)   ".."]
+        [(eq?    p 'same) "."]
+        [(equal? p "..")  "%2e%2e"]
+        [(equal? p ".")   "%2e"]
+        [else (uri-path-segment-encode p)]))
+
+(define (combine-path-strings absolute? path/params)
+  (cond [(null? path/params) ""]
+        [else (let ([p (string-join (map join-params path/params) "/")])
+                (if absolute? (string-append "/" p) p))]))
+
+(define (join-params s)
+  (string-join (map path-segment-encode
+                    (cons (path/param-path s) (path/param-param s)))
+               ";"))
+
+(define (path->url path)
+  (let ([url-path
+         (let loop ([path (simplify-path path #f)][accum null])
+           (let-values ([(base name dir?) (split-path path)])
+             (cond
+               [(not base)
+                (append (map
+                         (lambda (s)
+                           (make-path/param s null))
+                         (if (eq? (path-convention-type path) 'windows)
+                           ;; For Windows, massage the root:
+                           (let ([s (regexp-replace
+                                     #rx"[/\\\\]$"
+                                     (bytes->string/utf-8 (path->bytes name))
+                                     "")])
+                             (cond
+                               [(regexp-match? #rx"^\\\\\\\\[?]\\\\[a-zA-Z]:" s)
+                                ;; \\?\<drive>: path:
+                                (regexp-split #rx"[/\\]+" (substring s 4))]
+                               [(regexp-match? #rx"^\\\\\\\\[?]\\\\UNC" s)
+                                ;; \\?\ UNC path:
+                                (regexp-split #rx"[/\\]+" (substring s 7))]
+                               [(regexp-match? #rx"^[/\\]" s)
+                                ;; UNC path:
+                                (regexp-split #rx"[/\\]+" s)]
+                               [else
+                                (list s)]))
+                           ;; On other platforms, we drop the root:
+                           null))
+                        accum)]
+               [else
+                (let ([accum (cons (make-path/param
+                                    (if (symbol? name)
+                                      name
+                                      (bytes->string/utf-8
+                                       (path-element->bytes name)))
+                                    null)
+                                   accum)])
+                  (if (eq? base 'relative)
+                    accum
+                    (loop base accum)))])))])
+    (make-url "file" #f "" #f (absolute-path? path) url-path '() #f)))
+
+(define (url->path url [kind (system-path-convention-type)])
+  (file://->path url kind))
+
+;; delete-pure-port : url [x list (str)] -> in-port
+(define (delete-pure-port url [strings '()])
+  (method-pure-port 'delete url #f strings))
+
+;; delete-impure-port : url [x list (str)] -> in-port
+(define (delete-impure-port url [strings '()])
+  (method-impure-port 'delete url #f strings))
+
+;; head-pure-port : url [x list (str)] -> in-port
+(define (head-pure-port url [strings '()])
+  (method-pure-port 'head url #f strings))
+
+;; head-impure-port : url [x list (str)] -> in-port
+(define (head-impure-port url [strings '()])
+  (method-impure-port 'head url #f strings))
+
+;; put-pure-port : url bytes [x list (str)] -> in-port
+(define (put-pure-port url put-data [strings '()])
+  (method-pure-port 'put url put-data strings))
+
+;; put-impure-port : url x bytes [x list (str)] -> in-port
+(define (put-impure-port url put-data [strings '()])
+  (method-impure-port 'put url put-data strings))
+
+;; method-impure-port : symbol x url x list (str) -> in-port
+(define (method-impure-port method url data strings)
+  (let ([scheme (url-scheme url)])
+    (cond [(not scheme)
+           (schemeless-url url)]
+          [(or (string=? scheme "http") (string=? scheme "https"))
+           (http://method-impure-port method url data strings)]
+          [(string=? scheme "file")
+           (url-error "There are no impure file: ports")]
+          [else (url-error "Scheme ~a unsupported" scheme)])))
+
+;; method-pure-port : symbol x url x list (str) -> in-port
+(define (method-pure-port method url data strings)
+  (let ([scheme (url-scheme url)])
+    (cond [(not scheme)
+           (schemeless-url url)]
+          [(or (string=? scheme "http") (string=? scheme "https"))
+           (let ([port (http://method-impure-port
+                        method url data strings)])
+             (purify-http-port port))]
+          [(string=? scheme "file")
+           (file://get-pure-port url)]
+          [else (url-error "Scheme ~a unsupported" scheme)])))
+
+;; http://metod-impure-port : symbol x url x union (str, #f) x list (str) -> in-port
+(define (http://method-impure-port method url data strings)
+  (let*-values
+      ([(method) (case method
+                   [(get) "GET"] [(post) "POST"] [(head) "HEAD"]
+                   [(put) "PUT"] [(delete) "DELETE"]
+                   [else (url-error "unsupported method: ~a" method)])]
+       [(proxy) (assoc (url-scheme url) (current-proxy-servers))]
+       [(server->client client->server) (make-ports url proxy)]
+       [(access-string) (url->string
+                         (if proxy
+                           url
+                           (make-url #f #f #f #f
+                                     (url-path-absolute? url)
+                                     (url-path url)
+                                     (url-query url)
+                                     (url-fragment url))))])
+    (define (println . xs)
+      (for-each (lambda (x) (display x client->server)) xs)
+      (display "\r\n" client->server))
+    (println method " " access-string " HTTP/1.0")
+    (println "Host: " (url-host url)
+             (let ([p (url-port url)]) (if p (format ":~a" p) "")))
+    (when data (println "Content-Length: " (bytes-length data)))
+    (for-each println strings)
+    (println)
+    (when data (display data client->server))
+    (flush-output client->server)
+    (tcp-abandon-port client->server)
+    server->client))
 
 (provide (struct-out url) (struct-out path/param))
 
-(define current-https-protocol (make-parameter 'sslv2-or-v3))
-(provide current-https-protocol)
-
 (provide/contract
  (string->url ((or/c bytes? string?) . -> . url?))
  (path->url ((or/c path-string? path-for-some-system?) . -> . url?))
diff --git a/collects/planet/private/command.rkt b/collects/planet/private/command.rkt
index e41386552c..dad9767c20 100644
--- a/collects/planet/private/command.rkt
+++ b/collects/planet/private/command.rkt
@@ -112,7 +112,7 @@
 ;; are eaten in the process.
 (define (wrap-to-count str n)
   (cond
-    [(< (string-length str) n) (list str)]
+    [(<= (string-length str) n) (list str)]
     [(regexp-match-positions #rx"\n" str 0 n)
      =>
      (λ (posn)
diff --git a/collects/planet/private/planet-shared.rkt b/collects/planet/private/planet-shared.rkt
index b68161b3eb..ec274c508a 100644
--- a/collects/planet/private/planet-shared.rkt
+++ b/collects/planet/private/planet-shared.rkt
@@ -78,7 +78,18 @@ Various common pieces of code that both the client and server need to access
            check/take-installation-lock
            dir->successful-installation-file
            dir->unpacked-file
-           dir->metadata-files)
+           dir->metadata-files
+           
+           powerful-security-guard
+           with-powerful-security-guard)
+  
+  (define powerful-security-guard (make-parameter #f))
+  (define-syntax-rule 
+    (with-powerful-security-guard e1 e2 ...)
+    (with-powerful-security-guard/proc (λ () e1 e2 ...)))
+  (define (with-powerful-security-guard/proc t)
+    (parameterize ([current-security-guard (or (powerful-security-guard) (current-security-guard))])
+      (t)))
   
   ; ==========================================================================================
   ; CACHE LOGIC
@@ -222,25 +233,27 @@ Various common pieces of code that both the client and server need to access
   ;; get-hard-link-table/internal : -> assoc-table
   (define (get-hard-link-table/internal)
     (verify-well-formed-hard-link-parameter!)
-    (if (file-exists? (HARD-LINK-FILE))
-        (map (lambda (item) (update/create-element 6 (λ (_) 'development-link) (update-element 4 bytes->path item)))
-             (with-input-from-file (HARD-LINK-FILE) read-all))
-        '()))
+    (with-powerful-security-guard
+     (if (file-exists? (HARD-LINK-FILE))
+         (map (lambda (item) (update/create-element 6 (λ (_) 'development-link) (update-element 4 bytes->path item)))
+              (with-input-from-file (HARD-LINK-FILE) read-all))
+         '())))
   
   (define (with-hard-link-lock t)
-    (let-values ([(base name dir) (split-path (HARD-LINK-FILE))])
-      (try-make-directory* base))
-    (call-with-file-lock/timeout
-     (HARD-LINK-FILE)
-     'exclusive
-     t
-     (λ () 
-       (error 'planet/planet-shared.rkt "unable to obtain lock on ~s" (HARD-LINK-FILE)))))
+    (with-powerful-security-guard
+     (let-values ([(base name dir) (split-path (HARD-LINK-FILE))])
+       (try-make-directory* base))
+     (call-with-file-lock/timeout
+      (HARD-LINK-FILE)
+      'exclusive
+      t
+      (λ () 
+        (error 'planet/planet-shared.rkt "unable to obtain lock on ~s" (HARD-LINK-FILE))))))
   
   (define (get-hard-link-table)
     ;; we can only call with-hard-link-lock when the directory containing
     ;; (HARD-LINK-FILE) exists
-    (if (file-exists? (HARD-LINK-FILE))
+    (if (with-powerful-security-guard (file-exists? (HARD-LINK-FILE)))
         (with-hard-link-lock
          (λ ()
            (get-hard-link-table/internal)))
@@ -267,14 +280,15 @@ Various common pieces of code that both the client and server need to access
   ;; assumes that the lock on the HARD-LINK table file has been acquired
   (define (save-hard-link-table table)
     (verify-well-formed-hard-link-parameter!)
-    (with-output-to-file (HARD-LINK-FILE) #:exists 'truncate
-      (lambda ()
-        (display "")
-        (for-each 
-         (lambda (row)
-           (write (update-element 4 path->bytes row))
-           (newline))
-         table))))
+    (with-powerful-security-guard
+     (with-output-to-file (HARD-LINK-FILE) #:exists 'truncate
+       (lambda ()
+         (display "")
+         (for-each 
+          (lambda (row)
+            (write (update-element 4 path->bytes row))
+            (newline))
+          table)))))
   
   ;; add-hard-link! string (listof string) num num path -> void
   ;; adds the given hard link, clearing any previous ones already in place
@@ -770,7 +784,7 @@ Various common pieces of code that both the client and server need to access
   ;; make sure the lock file exists
   (with-handlers ((exn:fail:filesystem:exists? void))
     (call-with-output-file lf void))
-  (define p (open-output-file lf #:exists 'truncate))
+  (define p (with-powerful-security-guard (open-output-file lf #:exists 'truncate)))
   (cond
     [(port-try-file-lock? p 'exclusive)
      ;; we got the lock; keep the file open
diff --git a/collects/planet/private/resolver.rkt b/collects/planet/private/resolver.rkt
index 5ff32905a0..772bd9a028 100644
--- a/collects/planet/private/resolver.rkt
+++ b/collects/planet/private/resolver.rkt
@@ -341,7 +341,8 @@ See the scribble documentation on the planet/resolver module.
                  [current-eval (call-with-parameterization orig-paramz current-eval)]
                  [current-module-declare-name #f]
                  [use-compiled-file-paths (call-with-parameterization orig-paramz use-compiled-file-paths)]
-                 [current-library-collection-paths (call-with-parameterization orig-paramz current-library-collection-paths)])
+                 [current-library-collection-paths (call-with-parameterization orig-paramz current-library-collection-paths)]
+                 [powerful-security-guard (call-with-parameterization orig-paramz current-security-guard)])
     (let-values ([(path pkg) (get-planet-module-path/pkg/internal spec rmp stx load?)])
       (when load? (add-pkg-to-diamond-registry! pkg stx))
       (do-require path (pkg-path pkg) rmp stx load?))))
@@ -485,14 +486,15 @@ See the scribble documentation on the planet/resolver module.
     (try-make-directory* dir)
     (unless (equal? (normalize-path (uninstalled-pkg-path uninst-p))
                     (normalize-path full-pkg-path))
-      (call-with-file-lock/timeout
-       full-pkg-path
-       'exclusive
-       (λ ()
-         (when (file-exists? full-pkg-path) (delete-file full-pkg-path))
-         (copy-file (uninstalled-pkg-path uninst-p) full-pkg-path))
-       (λ ()
-         (log-error (format "planet/resolver.rkt: unable to save the planet package ~a" full-pkg-path)))))
+      (parameterize ([current-security-guard (or (powerful-security-guard) (current-security-guard))])
+        (call-with-file-lock/timeout
+         full-pkg-path
+         'exclusive
+         (λ ()
+           (when (file-exists? full-pkg-path) (delete-file full-pkg-path))
+           (copy-file (uninstalled-pkg-path uninst-p) full-pkg-path))
+         (λ ()
+           (log-error (format "planet/resolver.rkt: unable to save the planet package ~a" full-pkg-path))))))
     full-pkg-path))
 
 ;; =============================================================================
diff --git a/collects/profile/analyzer.rkt b/collects/profile/analyzer.rkt
index e114c4e369..82ad451cdd 100644
--- a/collects/profile/analyzer.rkt
+++ b/collects/profile/analyzer.rkt
@@ -1,10 +1,10 @@
-#lang scheme/base
+#lang racket/base
 
 ;; Analyzer for the sampler results
 
-(provide analyze-samples)
+(require "structs.rkt" "utils.rkt" racket/list)
 
-(require "structs.rkt" "utils.rkt" scheme/list)
+(provide analyze-samples (all-from-out "structs.rkt"))
 
 (define-syntax-rule (with-hash <hash> <key> <expr>)
   (hash-ref! <hash> <key> (lambda () <expr>)))
@@ -25,14 +25,14 @@
   (define id+src->node-hash (make-hasheq))
   (define (id+src->node id+src)
     (with-hash id+src->node-hash id+src
-               (make-node (car id+src) (cdr id+src) '() 0 0 '() '())))
+               (node (car id+src) (cdr id+src) '() 0 0 '() '())))
   ;; special node that is the caller of toplevels and callee of leaves
   (define *-node (id+src->node '(#f . #f)))
   (define call->edge
     (let ([t (make-hasheq)])
       (lambda (ler lee)
         (with-hash (with-hash t ler (make-hasheq)) lee
-                   (let ([e (make-edge 0 ler 0 lee 0)])
+                   (let ([e (edge 0 ler 0 lee 0)])
                      (set-node-callers! lee (cons e (node-callers lee)))
                      (set-node-callees! ler (cons e (node-callees ler)))
                      e)))))
@@ -84,14 +84,13 @@
     (for ([n (in-list nodes)])
       (set-node-callees! n (sort (node-callees n) > #:key edge-callee-time))
       (set-node-callers! n (sort (node-callers n) > #:key edge-caller-time)))
-    (make-profile
-     total-time
-     cpu-time
-     (length samples)
-     (for/list ([time (in-vector thread-times)] [n (in-naturals 0)])
-       (cons n time))
-     nodes
-     *-node)))
+    (profile total-time
+             cpu-time
+             (length samples)
+             (for/list ([time (in-vector thread-times)] [n (in-naturals 0)])
+               (cons n time))
+             nodes
+             *-node)))
 
 ;; Groups raw samples by their thread-id, returns a vector with a field for
 ;; each thread id holding the sample data for that thread.  The samples in
diff --git a/collects/profile/main.rkt b/collects/profile/main.rkt
index af103813fb..9827f42670 100644
--- a/collects/profile/main.rkt
+++ b/collects/profile/main.rkt
@@ -1,10 +1,10 @@
-#lang scheme/base
+#lang racket/base
 
 (provide profile-thunk profile)
 
-(require "sampler.rkt" "analyzer.rkt"
+(require "sampler.rkt" (except-in "analyzer.rkt" profile)
          (prefix-in text: "render-text.rkt")
-         (for-syntax scheme/base))
+         (for-syntax racket/base))
 
 (define (profile-thunk thunk
                        #:delay   [delay 0.05]
diff --git a/collects/profile/render-graphviz.rkt b/collects/profile/render-graphviz.rkt
index 1aba7cea6c..0c23a534a2 100644
--- a/collects/profile/render-graphviz.rkt
+++ b/collects/profile/render-graphviz.rkt
@@ -1,8 +1,8 @@
-#lang scheme/base
+#lang racket/base
 
 (provide render)
 
-(require "structs.rkt" "analyzer.rkt" "utils.rkt")
+(require "analyzer.rkt" "utils.rkt")
 
 (define (render profile
                 #:hide-self [hide-self% 1/100]
diff --git a/collects/profile/render-text.rkt b/collects/profile/render-text.rkt
index a0952fcf0d..61f21f31d4 100644
--- a/collects/profile/render-text.rkt
+++ b/collects/profile/render-text.rkt
@@ -1,8 +1,8 @@
-#lang at-exp scheme/base
+#lang at-exp racket/base
 
 (provide render)
 
-(require "structs.rkt" "analyzer.rkt" "utils.rkt" scheme/list)
+(require "analyzer.rkt" "utils.rkt" racket/list)
 
 (define (f:msec msec)
   (number->string (round (inexact->exact msec))))
diff --git a/collects/profile/sampler.rkt b/collects/profile/sampler.rkt
index 7529135373..9dadc6bfe2 100644
--- a/collects/profile/sampler.rkt
+++ b/collects/profile/sampler.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 ;; The core profiler sample collector
 ;; (This module is a private tool for collecting profiling data, and should not
diff --git a/collects/profile/scribblings/analyzer.scrbl b/collects/profile/scribblings/analyzer.scrbl
index 418458a250..1a22a7d54a 100644
--- a/collects/profile/scribblings/analyzer.scrbl
+++ b/collects/profile/scribblings/analyzer.scrbl
@@ -1,45 +1,45 @@
 #lang scribble/doc
 
 @(require scribble/manual
-          (for-label scheme profile/analyzer))
+          (for-label racket/base profile/analyzer))
 
 @title[#:tag "analyzer"]{Analyzing Profile Data}
 
 @defmodule[profile/analyzer]
 
-Once a profile run is done, and the results are collected, the next
-step is to analyze the data.  In this step the sample time are
-computed and summed, a call-graph representing the observed function
-calls is built, and per-node and per-edge information is created.
-This is the job of the main function provided by
-@racket[profile/analyzer].
+Once a profile run is done and the results are collected, the next
+step is to analyze the data.  In this step sample times are computed
+and summed, a call-graph representing observed function calls is
+built, and per-node and per-edge information is created.  This is the
+job of the main function provided by @racket[profile/analyzer].
 
 @defproc[(analyze-samples [raw-sample-data any/c])
          profile?]{
 
 This function consumes the raw result of the
-@seclink["sampler"]{sampler} (which is given in an undocumented form),
-analyzes it, and returns a @racket[profile] value holding the analyzed
-results.  Without this function, the results of the sampler are
+@seclink["sampler"]{sampler} (given in an undocumented form), analyzes
+it, and returns a @racket[profile] value holding the analyzed results.
+Without this function, the results of the sampler should be considered
 meaningless.}
 
 
-@defstruct[profile ([total-time exact-nonnegative-integer?]
-                    [cpu-time   exact-nonnegative-integer?]
-                    [sample-number exact-nonnegative-integer?]
-                    [thread-times  (listof (cons exact-nonnegative-integer?
-                                                 exact-nonnegative-integer?))]
-                    [nodes  (listof node?)]
-                    [*-node node?])]{
+@defstruct*[profile ([total-time exact-nonnegative-integer?]
+                     [cpu-time   exact-nonnegative-integer?]
+                     [sample-number exact-nonnegative-integer?]
+                     [thread-times  (listof (cons exact-nonnegative-integer?
+                                                  exact-nonnegative-integer?))]
+                     [nodes  (listof node?)]
+                     [*-node node?])]{
 
-Represents the analyzed profile result.
+Represents an analyzed profile result.
 
 @itemize[
 
 @item{@racket[total-time] is the total observed time (in milliseconds)
-  included in the profile.  This is different than the actual time the
-  profiling took, due to unaccounted-for time spent in untracked
-  threads.  (E.g., the sampler thread itself.)}
+  included in the profile run.  This can be different from the actual
+  time the profiling took, due to unaccounted-for time spent in
+  untracked threads.  (E.g., time spent in the sampler thread
+  itself.)}
 
 @item{@racket[cpu-time] is the actual cpu time consumed by the process
   during the profiler's work.}
@@ -61,69 +61,70 @@ Represents the analyzed profile result.
   amount of time (time spent either in the function or in its callees)
   as a secondary key.}
 
-@item{@racket[*-node] holds a ``special'' node value that is
-  constructed for every graph.  This node is used as the caller for
-  all top-level function nodes and as the callee for all leaf nodes.
-  It can therefore be used to start a scan of the call graph.  In
-  addition, the times associated with its "callers and callees"
-  actually represent the time these functions spent being the root of
-  the computation or its leaf.  (This can be different from a node's
-  ``self'' time, since it is divided by the number of instances a
-  function had on the stack for every sample --- so for recursive
-  functions this value is different from.)}
+@item{@racket[*-node] holds a ``special'' root node value that is
+  constructed for every call graph.  This node is used as the caller
+  for all top-level function nodes and as the callee for all leaf
+  nodes.  It can therefore be used to start a recursive scan of the
+  call graph.  In addition, the times associated with its ``callers''
+  and ``callees'' actually represent the time these functions spent
+  being the root of the computation or its leaf.  (This can be
+  different from a node's ``self'' time, since it is divided by the
+  number of instances a function had on the stack in each sample---so
+  for recursive functions this value is always different from the
+  ``self'' time.)}
 
 ]}
 
 
-@defstruct[node ([id      (or/c #f symbol?)]
-                 [src     (or/c #f srcloc?)]
-                 [thread-ids (listof exact-nonnegative-integer?)]
-                 [total   exact-nonnegative-integer?]
-                 [self    exact-nonnegative-integer?]
-                 [callers (listof edge?)]
-                 [callees (listof edge?)])]{
+@defstruct*[node ([id      (or/c #f symbol?)]
+                  [src     (or/c #f srcloc?)]
+                  [thread-ids (listof exact-nonnegative-integer?)]
+                  [total   exact-nonnegative-integer?]
+                  [self    exact-nonnegative-integer?]
+                  [callers (listof edge?)]
+                  [callees (listof edge?)])]{
 
 Represents a function call node in the call graph of an analyzed
 profile result.
 
 @itemize[
 
-@item{The @racket[id] and @racket[src] field hold a symbol naming the
+@item{The @racket[id] and @racket[src] fields hold a symbol naming the
   function and/or its source location as a @racket[srcloc] value.
   This is the same as the results of
-  @racket[continuation-mark-set->context], so at most of of these can
+  @racket[continuation-mark-set->context], so at most one of these can
   be @racket[#f], except for the special @racket[*-node] (see the
-  @racket[profile] struct) that can be identified by both of these
-  being @racket[#f].}
+  @racket[profile] struct) that can be identified by both being
+  @racket[#f].}
 
 @item{@racket[thread-ids] holds a list of thread identifiers that were
   observed executing this function.}
 
-@item{@racket[total] holds the total time (in milliseconds) where this
+@item{@racket[total] holds the total time (in milliseconds) that this
   function was anywhere on the stack.  It is common to see a few
   toplevel functions that have close to a 100% total time, but
-  otherwise small @racket[self] times --- these functions are the ones
-  that derive the work that was done, but they don't do any hard work
+  otherwise small @racket[self] times---these functions are the ones
+  that initiate the actual work, but they don't do any hard work
   directly.}
 
-@item{@racket[self] holds the total time (in milliseconds) where this
+@item{@racket[self] holds the total time (in milliseconds) that this
   function was observed as the leaf of the stack.  It represents the
-  actual work done by this function, rather than @racket[total] that
-  represents the work done by both the function and its callees.}
+  actual work done by this function, rather than the @racket[total]
+  time spent by both the function and its callees.}
 
-@item{@racket[callers] and @racket[callees] hold the list of caller
-  and callee nodes.  The nodes are not actually held in these lists,
-  instead, @racket[edge] values are used --- and provide information
-  specific to an edge in the call-graph.}
+@item{@racket[callers] and @racket[callees] hold the list of callers
+  and callees.  The nodes are not actually held in these lists,
+  instead, @racket[edge] values are used---and provide information
+  specific to each edge in the call-graph.}
 
 ]}
 
 
-@defstruct[edge ([total       exact-nonnegative-integer?]
-                 [caller      node?]
-                 [caller-time exact-nonnegative-integer?]
-                 [callee      node?]
-                 [callee-time exact-nonnegative-integer?])]{
+@defstruct*[edge ([total       exact-nonnegative-integer?]
+                  [caller      node?]
+                  [caller-time exact-nonnegative-integer?]
+                  [callee      node?]
+                  [callee-time exact-nonnegative-integer?])]{
 
 Represents an edge between two function call nodes in the call graph
 of an analyzed profile result.
diff --git a/collects/profile/scribblings/profile.scrbl b/collects/profile/scribblings/profile.scrbl
index ba8a4949be..e07a7b449a 100644
--- a/collects/profile/scribblings/profile.scrbl
+++ b/collects/profile/scribblings/profile.scrbl
@@ -1,15 +1,15 @@
 #lang scribble/doc
 
 @(require scribble/manual
-          (for-label scheme))
+          (for-label racket/base))
 
 @title{Profile: Statistical Profiler}
 
-The @racket[profile] collection implements a statistical profiler.
-The profiling is done by running a background thread that collects
-stack snapshots via @racket[continuation-mark-set->context], meaning
-that the result is an estimate of the execution costs and it is
-limited to the kind of information that
+The @racketmodname[profile] collection implements a statistical
+profiler.  The profiling is done by running a background thread that
+collects stack snapshots via @racket[continuation-mark-set->context],
+meaning that the result is an estimate of the execution costs and it
+is limited to the kind of information that
 @racket[continuation-mark-set->context] produces (most notably being
 limited to functions calls, and subject to compiler optimizations);
 but the result is often useful.  In practice, since this method does
diff --git a/collects/profile/scribblings/renderers.scrbl b/collects/profile/scribblings/renderers.scrbl
index 8486b58a6f..641b64bb9f 100644
--- a/collects/profile/scribblings/renderers.scrbl
+++ b/collects/profile/scribblings/renderers.scrbl
@@ -1,7 +1,7 @@
 #lang scribble/doc
 
 @(require scribble/manual
-          (for-label scheme
+          (for-label racket/base
                      profile/analyzer
                      (prefix-in text: profile/render-text)
                      (prefix-in graphviz: profile/render-graphviz)))
@@ -9,11 +9,11 @@
 @title[#:tag "renderers"]{Profile Renderers}
 
 After collecting the profile samples and analyzing the data, the last
-aspect of profiling is to render the results.  The profile collection
-provides several renderers, each providing a rendering function that
-consumes a @racket[profile] instance.  See the
+step of the profiling process is to render the results.  The profile
+collection provides several renderers, each providing a rendering
+function that consumes a @racket[profile] instance.  See the
 @seclink["analyzer"]{analyzer} section for a description of the
-@racket[profile] struct if you want to implement your own renderer.
+@racket[profile] struct if you want to implement a new renderer.
 
 @;--------------------------------------------------------------------
 @section{Textual Rendering}
@@ -29,7 +29,7 @@ consumes a @racket[profile] instance.  See the
 
 Prints the given @racket[profile] results as a textual table.
 
-The printout begins with some general facts about the profile, and
+The printout begins with some general details about the profile, and
 then a table that represents the call-graph is printed.  Each row in
 this table looks like:
 
@@ -38,17 +38,17 @@ this table looks like:
   [N1] N2(N3%) N4(N5%)  A ...path/to/source.rkt:12:34
                           C [M3] M4%}
 
-Where actual numbers appear in the printout.  The meaning of the
+where actual numbers appear in the printout.  The meaning of the
 numbers and labels is as follows:
 @itemize[
 @item{@tt{A} --- the name of the function that this node represents,
   followed by the source location for the function if it is known.
-  The name can be ``???'' for functions with no identifier, but in
-  this case the source location will identify them.}
+  The name can be ``???'' for anonymous functions, but in this case
+  the source location will identify them.}
 @item{@tt{N1} --- an index number associated with this node.  This is
-  important in references to this function, since the symbolic names
-  are not unique (and some can be missing).  The number itself has no
-  significance, it simply goes from 1 up.}
+  useful in references to this function, since the symbolic names are
+  not unique (and some can be missing).  The number itself has no
+  significance.}
 @item{@tt{N2} --- the time (in milliseconds) that this function has
   been anywhere in a stack snapshot.  This is the total time that the
   execution was somewhere in this function or in its callees.
@@ -59,13 +59,12 @@ numbers and labels is as follows:
   whole execution.}
 @item{@tt{N4} --- the time (in milliseconds) that this function has
   been at the top of the stack snapshot.  This is the time that this
-  function consumed doing work itself rather than calling other
-  functions.  (Corresponds to the @racket[node-self] field.)}
+  function was itself doing work rather than calling other functions.
+  (Corresponds to the @racket[node-self] field.)}
 @item{@tt{N5} --- this is the percentage of @tt{N4} out of the total
   observed time of the profile.  Functions with high values here can
   be good candidates for optimization, But, of course, they can
-  represent doing real work due to one of its callers that need to be
-  optimized.}
+  represent doing real work for a caller that needs to be optimized.}
 @item{@tt{B} and @tt{C} --- these are labels for the callers and
   callees of the function.  Any number of callers and callees can
   appear here (including 0).  The function itself can also appear in
diff --git a/collects/profile/scribblings/sampler.scrbl b/collects/profile/scribblings/sampler.scrbl
index f6d15307c2..908521ce7c 100644
--- a/collects/profile/scribblings/sampler.scrbl
+++ b/collects/profile/scribblings/sampler.scrbl
@@ -1,7 +1,7 @@
 #lang scribble/doc
 
 @(require scribble/manual
-          (for-label scheme profile/sampler profile/analyzer))
+          (for-label racket/base profile/sampler profile/analyzer))
 
 @title[#:tag "sampler"]{Collecting Profile Information}
 
@@ -13,7 +13,7 @@
                          [super-cust custodian? (current-custodian)])
          ((symbol?) (any/c) . ->* . any/c)]{
 
-Creates a sample collector thread, which tracks the given
+Creates a stack-snapshot collector thread, which tracks the given
 @racket[to-track] value every @racket[delay] seconds.  The
 @racket[to-track] value can be either a thread (track just that
 thread), a custodian (track all threads managed by the custodian), or
@@ -26,33 +26,33 @@ consisting of a symbol and an optional argument, and can affect the
 sampler.  The following messages are currently supported:
 @itemize[
 
-@item{@racket['pause] and @racket['resume] will stop or resume data
-collection.  These messages can be nested.  Note that the thread will
-continue running it will just stop collecting snapshots.}
+@item{@racket['pause] and @racket['resume] will stop or resume
+  snapshot collection.  These messages can be nested.  Note that the
+  thread will continue running---it will just stop collecting
+  snapshots.}
 
-@item{@racket['stop] kills the controlled thread.  It should be called
+@item{@racket['stop] kills the sampler thread.  It should be called
   when no additional data should be collected.  (This is currently
   irreversible: there is no message to start a new sampler thread.)}
 
 @item{@racket['set-tracked!] with a value will change the tracked
-  objects (initially specified as the @racket[to-track] argument) to
-  the given value.}
+  object(s) which were initially specified as the @racket[to-track]
+  argument.}
 
-@item{@racket['set-tracked!] with a value will change the delay that
-  the sampler us taking between snapshots.  Note that although
-  changing this means that the snapshots are not uniformly
-  distributed, the results will still be sensible --- this is because
-  the cpu time between samples is taken into account when the
-  resulting data is analyzed.}
+@item{@racket['set-tracked!] with a numeric value will change the
+  delay that the sampler is taking between snapshots.  Note that
+  although changing this means that the snapshots are not uniformly
+  distributed, the results will still be correct: the cpu time between
+  samples is taken into account when the collected data is analyzed.}
 
 @item{Finally, a @racket['get-snapshots] message will make the
   controller return the currently collected data.  Note that this can
-  be called multiple times, each call will return the data thatis
+  be called multiple times, each call will return the data that is
   collected up to that point in time.  In addition, it can be (and
   usually is) called after the sampler was stopped.
 
   The value that is returned should be considered as an undocumented
-  internal detail of the profiler, to be sent to
+  internal detail of the profiler, intended to be sent to
   @racket[analyze-samples] for analysis.  The reason this is not done
   automatically, is that a future extension might allow you to combine
   several sampler results, making it possible to combine a profile
diff --git a/collects/profile/scribblings/toplevel.scrbl b/collects/profile/scribblings/toplevel.scrbl
index de0ebe5d7f..be663a796b 100644
--- a/collects/profile/scribblings/toplevel.scrbl
+++ b/collects/profile/scribblings/toplevel.scrbl
@@ -1,8 +1,8 @@
 #lang scribble/doc
 
 @(require scribble/manual
-          (for-label scheme profile profile/sampler
-                     (only-in profile/analyzer analyze-samples)
+          (for-label racket/base profile profile/sampler
+                     (only-in profile/analyzer analyze-samples profile?)
                      (prefix-in text: profile/render-text)))
 
 @title{Toplevel Interface}
@@ -10,7 +10,7 @@
 @defmodule[profile]
 
 This module provides one procedure and one macro that are convenient
-high-level entry points for timing expressions.  This hides the
+high-level entry points for profiling expressions.  It abstracts over
 details that are available through other parts of the library, and is
 intended as a convenient tool for profiling code.
 
@@ -25,53 +25,55 @@ intended as a convenient tool for profiling code.
            #f])
          void?]{
 
-Executes the given thunk while collecting profiling data, and render
-this data when done.  Keyword arguments can customize the profiling:
+Executes the given @racket[thunk] and collect profiling data during
+execution, eventually analyzing and rendering this.  Keyword arguments
+can customize the profiling:
 @itemize[
 
-@item{The profiler works by @racket[create-sampler] starting a
-  ``sampler'' thread whose job is to collect stack samples
-  periodically (using @racket[continuation-mark-set->context]).
-  @racket[delay] determines the amount of time the sampler
-  @racket[sleep]s for between samples.  Note that this is will be
-  close, but not identical to, the frequency in which data is actually
-  sampled.}
+@item{The profiler works by starting a ``sampler'' thread to
+  periodically collect stack snapshots (using
+  @racket[continuation-mark-set->context]).  To determine the
+  frequency of these collections, the sampler thread sleeps
+  @racket[delay] seconds between collections.  Note that this is will
+  be close, but not identical to, the frequency in which data is
+  actually sampled.  (The @racket[delay] value is passed on to
+  @racket[create-sampler], which creates the sampler thread.)}
 
-@item{When the profiled computation takes a short amount of time, the
-  collected data will not be accurate.  In this case, you can specify
-  an @racket[iterations] argument to repeat the evaluation a number of
-  times which will improve the accuracy of the resulting report.}
+@item{Due to the statistical nature of the profiler, longer executions
+  result in more accurate analysis.  You can specify a number of
+  @racket[iterations] to repeat the @racket[thunk] to collect more
+  data.}
 
-@item{Normally, the sampler collects snapshots of the
-  @racket[current-thread]'s stack.  If there is some computation that
-  happens on a different thread, that work will not be reflected in
-  the results: the only effect will be suspiciously small value for
-  the observed time, because the collected data is taking into account
-  the cpu time that the thread actually performed (it uses
-  @racket[current-process-milliseconds] with the running thread as an
-  argument).  Specifying a non-@racket[#f] value for the
-  @racket[threads?] argument will arrange for all threads that are
-  started during the evaluation to be tracked.  Note that this means
-  that the computation will actually run in a new sub-custodian, as
-  this is the only way to be able to track such threads.}
+@item{Normally, the sampler collects only snapshots of the
+  @racket[current-thread]'s stack.  Profiling a computation that
+  creates threads will therefore lead to bad analysis: the timing
+  results will be correct, but because the profiler is unaware of
+  other threads the observed time will be suspiciously small, and work
+  done in other threads will not be included in the results.  To track
+  all threads, specify a non-@racket[#f] value for the
+  @racket[threads?] argument---this will execute the computation in a
+  fresh custodian, and keep track of all threads under this
+  custodian.}
 
-@item{Once the computation has finished, the sampler is stopped, and
-  the accumulated data is collected.  It is then analyzed by
-  @racket[analyze-samples], and the analyzed profile data is fed into
-  a renderer.  Use an identity function (@racket[values]) to get the
-  analyzed result, and render it yourself, or use one of the existing
-  renderers (see @secref["renderers"]).}
+@item{Once the computation is done and the sampler is stopped, the
+  accumulated data is analyzed (by @racket[analyze-samples]) and the
+  resulting profile value is sent to the @racket[renderer] function.
+  See @secref["renderers"] for available renderers.  You can also use
+  @racket[values] as a ``renderer''---in this case the
+  @racket[profile-thunk] returns the analyzed information which can
+  now be rendered multiple times, or saved for future rendering.}
 
-@item{The @racket[periodic-renderer] argument can be set to a list
-  holding a delay time and a renderer.  In this case, the given
-  renderer will be called periodically.  This is useful for cases
-  where you want a dynamically updated display of the results.  This
-  delay should be larger than the sampler delay.}
+@item{To provide feedback information during execution, specify a
+  @racket[periodic-renderer].  This should be a list holding a delay
+  time (in seconds) and a renderer function.  The delay determines the
+  frequency in which the renderer is called, and it should be larger
+  than the sampler delay (usually much larger since it can involve
+  more noticeable overhead, and it is intended for a human observer).}
 
 ]}
 
 @defform[(profile expr keyword-arguments ...)]{
 
-A macro version of @racket[profile-thunk].  The keyword arguments can
-be specified in the same was as for a function call: they can appear
-before and/or after the expression to be profiled.}
+A macro version of @racket[profile-thunk].  Keyword arguments can be
+specified as in a function call: they can appear before and/or after
+the expression to be profiled.}
diff --git a/collects/profile/structs.rkt b/collects/profile/structs.rkt
index 9732e7c726..1f6a513bd6 100644
--- a/collects/profile/structs.rkt
+++ b/collects/profile/structs.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 ;; Struct definitions for the profiler
 
@@ -14,7 +14,7 @@
 ;;   identifiable by having both id and src fields being #f.  Can be used to
 ;;   start a graph traversal from the top or the bottom.
 (provide (struct-out profile))
-(define-struct profile
+(struct profile
   (total-time cpu-time sample-number thread-times nodes *-node))
 
 ;; An entry for a single profiled function:
diff --git a/collects/profile/utils.rkt b/collects/profile/utils.rkt
index 7486ce3b30..8b9430eb15 100644
--- a/collects/profile/utils.rkt
+++ b/collects/profile/utils.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require "structs.rkt" scheme/list scheme/nest)
+(require "structs.rkt" racket/list)
 
 ;; Format a percent number, possibly doing the division too.  If we do the
 ;; division, then be careful: if we're dividing by zero, then make the result
diff --git a/collects/r6rs/main.rkt b/collects/r6rs/main.rkt
index d4dd0dcb13..b5cc3f3a60 100644
--- a/collects/r6rs/main.rkt
+++ b/collects/r6rs/main.rkt
@@ -161,7 +161,7 @@ FIXME:
                         (free-identifier=? id #'def)))
                  (list #'define-values
                        #'define-syntaxes
-                       #'define-values-for-syntax))
+                       #'begin-for-syntax))
           #`(begin #,a (library-body/defns . more))]
          [(#%require . _)
           ;; We allow `require' mixed with definitions, because it
@@ -268,9 +268,8 @@ FIXME:
                                (hash-set! table
                                           (syntax-e id)
                                           (cons (cons id phase) l))))))])
-          (let-values ([(ids for-syntax-ids) (syntax-local-module-defined-identifiers)])
-            (for-each (map-id 0) ids)
-            (for-each (map-id 1) for-syntax-ids))
+          (for ([(phase ids) (in-hash (syntax-local-module-defined-identifiers))])
+            (for-each (map-id phase) ids))
           (for-each (lambda (l)
                       (if (car l)
                           (for-each (map-id (car l)) (cdr l))
diff --git a/collects/racket/match/define-forms.rkt b/collects/racket/match/define-forms.rkt
index 608ba1c735..ff116d5134 100644
--- a/collects/racket/match/define-forms.rkt
+++ b/collects/racket/match/define-forms.rkt
@@ -2,6 +2,7 @@
 
 (require (for-syntax scheme/base
                      racket/syntax
+                     (only-in racket/list append* remove-duplicates)
                      unstable/sequence
                      syntax/parse
                      "parse.rkt"
@@ -12,20 +13,22 @@
 (provide define-forms)
 
 (define-syntax-rule (define-forms parse-id
-                      match match* match-lambda match-lambda* 
-		      match-lambda** match-let match-let* 
-		      match-define match-letrec
-		      match/derived match*/derived)
+                      match match* match-lambda match-lambda*
+		      match-lambda** match-let match-let*
+                      match-let-values match-let*-values
+		      match-define match-define-values match-letrec
+		      match/values match/derived match*/derived)
   (...
    (begin
      (provide match match* match-lambda match-lambda* match-lambda**
-	      match-let match-let* match-define match-letrec
-	      match/derived match*/derived)
+	      match-let match-let* match-let-values match-let*-values
+              match-define match-define-values match-letrec
+	      match/values match/derived match*/derived match-define-values)
      (define-syntax (match* stx)
        (syntax-parse stx
          [(_ es . clauses)
           (go parse-id stx #'es #'clauses)]))
-     
+
      (define-syntax (match*/derived stx)
        (syntax-parse stx
          [(_ es orig-stx . clauses)
@@ -35,26 +38,33 @@
        (syntax-parse stx
          [(_ arg:expr clauses ...)
           (go/one parse-id stx #'arg #'(clauses ...))]))
-     
+
      (define-syntax (match/derived stx)
        (syntax-parse stx
          [(_ arg:expr orig-stx clauses ...)
           (go/one parse-id #'orig-stx #'arg #'(clauses ...))]))
 
+     (define-syntax (match/values stx)
+       (syntax-parse stx
+         [(_ arg:expr [(pats ...) rhs:expr] [(patss ...) rhss:expr] ...)
+          (with-syntax ([(ids ...) (generate-temporaries #'(pats ...))])
+            #`(let-values ([(ids ...) arg])
+                (match*/derived (ids ...) #,stx [(pats ...) rhs] [(patss ...) rhss] ...)))]))
+
      (define-syntax (match-lambda stx)
        (syntax-parse stx
          [(_ . clauses)
           (with-syntax* ([arg (generate-temporary)]
                          [body #`(match/derived arg #,stx . clauses)])
             (syntax/loc stx (lambda (arg) body)))]))
-     
+
      (define-syntax (match-lambda* stx)
        (syntax-parse stx
          [(_ . clauses)
           (with-syntax* ([arg (generate-temporary)]
                          [body #`(match/derived arg #,stx . clauses)])
             (syntax/loc stx (lambda arg body)))]))
-     
+
      (define-syntax (match-lambda** stx)
        (syntax-parse stx
          [(_ (~and clauses [(pats ...) . rhs]) ...)
@@ -62,37 +72,53 @@
                          [body #`(match*/derived vars #,stx clauses ...)])
             (syntax/loc stx (lambda vars body)))]))
 
+
+     (define-syntax (match-let-values stx)
+       (syntax-parse stx
+         [(_ (~and clauses ([(patss ...) rhss:expr] ...)) body1 body ...)
+          (define-values (idss let-clauses)
+            (for/lists (idss let-clauses)
+                ([pats (syntax->list #'((patss ...) ...))]
+                 [rhs (syntax->list #'(rhss ...))])
+              (define ids (generate-temporaries pats))
+              (values ids #`[#,ids #,rhs])))
+          #`(let-values #,let-clauses
+              (match*/derived #,(append* idss) #,stx
+                [(patss ... ...) (let () body1 body ...)]))]))
+
+     (define-syntax (match-let*-values stx)
+       (syntax-parse stx
+         [(_ () body1 body ...)
+          #'(let () body1 body ...)]
+         [(_ ([(pats ...) rhs] rest-pats ...) body1 body ...)
+          (with-syntax ([(ids ...) (generate-temporaries #'(pats ...))])
+            #`(let-values ([(ids ...) rhs])
+                (match*/derived (ids ...) #,stx
+                  [(pats ...) #,(syntax/loc stx (match-let*-values (rest-pats ...)
+                                                  body1 body ...))])))]))
+
      ;; there's lots of duplication here to handle named let
      ;; some factoring out would do a lot of good
-     (define-syntax (match-let stx)       
+     (define-syntax (match-let stx)
        (syntax-parse stx
          [(_ nm:id (~and clauses ([pat init-exp:expr] ...)) body1 body ...)
           (with-syntax*
            ([vars (generate-temporaries #'(pat ...))]
-            [loop-body #`(match*/derived vars #,stx 
-					 [(pat ...) (let () body1 body ...)])])
+            [loop-body #`(match*/derived vars #,stx
+                           [(pat ...) (let () body1 body ...)])])
            #'(letrec ([nm (lambda vars loop-body)])
                (nm init-exp ...)))]
-         [(_ (~and clauses ([pat init-exp:expr] ...)) body1 body ...)
-          #`(match*/derived (init-exp ...) #,stx 
-			    [(pat ...) (let () body1 body ...)])]))
+         [(_ ([pat init-exp:expr] ...) body1 body ...)
+          #`(match-let-values ([(pat) init-exp] ...) body1 body ...)]))
 
-     (define-syntax (match-let* stx)
-       (syntax-parse stx
-         [(_ () body1 body ...)
-          #'(let () body1 body ...)]
-         [(_ ([pat exp] rest-pats ...) body1 body ...)
-          #`(match*/derived 
-             (exp)
-             #,stx
-             [(pat) #,(syntax/loc stx (match-let* (rest-pats ...) 
-					 body1 body ...))])]))
+     (define-syntax-rule (match-let* ([pat exp] ...) body1 body ...)
+       (match-let*-values ([(pat) exp] ...) body1 body ...))
 
      (define-syntax (match-letrec stx)
        (syntax-parse stx
          [(_ ((~and cl [pat exp]) ...) body1 body ...)
           (quasisyntax/loc stx
-			   (let () 
+			   (let ()
                             #,@(for/list ([c (in-syntax #'(cl ...))]
                                           [p (in-syntax #'(pat ...))]
                                           [e (in-syntax #'(exp ...))])
@@ -100,10 +126,24 @@
                             body1 body ...))]))
 
      (define-syntax (match-define stx)
-       (syntax-parse stx        
+       (syntax-parse stx
          [(_ pat rhs:expr)
           (let ([p (parse-id #'pat)])
             (with-syntax ([vars (bound-vars p)])
               (quasisyntax/loc stx
                 (define-values vars (match*/derived (rhs) #,stx
-				      [(pat) (values . vars)])))))])))))
+				      [(pat) (values . vars)])))))]))
+
+     (define-syntax (match-define-values stx)
+       (syntax-parse stx
+         [(_ (pats ...) rhs:expr)
+          (define bound-vars-list (remove-duplicates
+                                   (foldr (λ (pat vars)
+                                             (append (bound-vars (parse-id pat)) vars))
+                                          '() (syntax->list #'(pats ...)))
+                                   bound-identifier=?))
+          (with-syntax ([(ids ...) (generate-temporaries #'(pats ...))])
+            (quasisyntax/loc stx
+              (define-values #,bound-vars-list
+                (match/values rhs
+                  [(pats ...) (values . #,bound-vars-list)]))))])))))
diff --git a/collects/racket/match/legacy-match.rkt b/collects/racket/match/legacy-match.rkt
index b9abbfd220..e607fbd2b8 100644
--- a/collects/racket/match/legacy-match.rkt
+++ b/collects/racket/match/legacy-match.rkt
@@ -17,4 +17,5 @@
 
 (define-forms parse/legacy
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
-  match-define match-letrec match/derived match*/derived)
+  match-let-values match-let*-values
+  match-define match-define-values match-letrec match/values match/derived match*/derived)
diff --git a/collects/racket/match/match.rkt b/collects/racket/match/match.rkt
index edb5761519..345b66ea5c 100644
--- a/collects/racket/match/match.rkt
+++ b/collects/racket/match/match.rkt
@@ -19,4 +19,5 @@
 
 (define-forms parse
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
-  match-define match-letrec match/derived match*/derived)
+  match-let-values match-let*-values
+  match-define match-define-values match-letrec match/values match/derived match*/derived)
diff --git a/collects/racket/place.rkt b/collects/racket/place.rkt
index bc4b752088..a8bd6f8604 100644
--- a/collects/racket/place.rkt
+++ b/collects/racket/place.rkt
@@ -143,19 +143,28 @@
     (syntax-case stx ()
       [(_ a ...) b ...])))
 
-(define-for-syntax (gen-create-place stx)
- (syntax-case stx ()
-   [(_ ch body ...)
-     (unless (identifier? #'ch)
-          (raise-syntax-error #f "expected an indentifier" stx #'ch))
-     (with-syntax ([interal-def-name
-                    (syntax-local-lift-expression #'(lambda (ch) body ...))]
-                   [funcname (datum->syntax stx (generate-temporary #'place/anon))])
-      (syntax-local-lift-provide #'(rename interal-def-name funcname))
-      #'(let ([module-path (resolved-module-path-name
-              (variable-reference->resolved-module-path
-               (#%variable-reference)))])
-       (dynamic-place module-path (quote funcname))))]))
-
 (define-syntax (place stx)
-  (gen-create-place stx))
+  (syntax-case stx ()
+    [(_ ch body1 body ...)
+     (begin
+       #;(when (in-module-expansion?)
+         (raise-syntax-error #f "can only be used in a module" stx))
+       (unless (identifier? #'ch)
+         (raise-syntax-error #f "expected an indentifier" stx #'ch))
+       (with-syntax ([internal-def-name
+                      (syntax-local-lift-expression #'(lambda (ch) body1 body ...))]
+                     [func-name (generate-temporary #'place/anon)])
+         (syntax-local-lift-provide #'(rename internal-def-name func-name))
+         #'(place/proc (#%variable-reference) 'func-name)))]
+    [(_ ch)
+     (raise-syntax-error #f "expected at least one body expression" stx)]))
+
+(define (place/proc vr func-name)
+  (define name
+    (resolved-module-path-name
+     (variable-reference->resolved-module-path
+      vr)))
+  (when (symbol? name)
+     (error 'place "the current module-path-name should be a path and not a symbol (if you are in DrRacket, save the file)"))
+  (dynamic-place name func-name))
+
diff --git a/collects/racket/private/define.rkt b/collects/racket/private/define.rkt
index 9c955c88f3..8df9e8050d 100644
--- a/collects/racket/private/define.rkt
+++ b/collects/racket/private/define.rkt
@@ -7,7 +7,22 @@
                          "letstx-scheme.rkt" "stxcase-scheme.rkt" "stx.rkt" "qqstx.rkt"
                          "norm-define.rkt"))
 
-  (#%provide define define-syntax define-for-syntax begin-for-syntax)
+  (#%provide define 
+             define-syntax 
+             define-values-for-syntax
+             define-for-syntax)
+
+  (define-syntaxes (define-values-for-syntax)
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ (id ...) expr)
+         (begin
+           (for-each (lambda (x)
+                       (unless (identifier? x)
+                         (raise-syntax-error #f "not an identifier" x stx)))
+                     (syntax->list #'(id ...)))
+           #'(begin-for-syntax
+              (define-values (id ...) expr)))])))
 
   (define-syntaxes (define define-syntax define-for-syntax)
     (let ([go
@@ -18,64 +33,4 @@
                  (#,define-values-stx (#,id) #,rhs))))])
       (values (lambda (stx) (go #'define-values stx))
 	      (lambda (stx) (go #'define-syntaxes stx))
-              (lambda (stx) (go #'define-values-for-syntax stx)))))
-
-  (define-syntaxes (begin-for-syntax)
-    (lambda (stx)
-      (let ([ctx (syntax-local-context)])
-	(unless (memq ctx '(module module-begin top-level))
-	  (raise-syntax-error #f "allowed only at the top-level or a module top-level" stx))
-	(syntax-case stx ()
-	  [(_) #'(begin)]
-	  [(_ elem)
-	   (not (eq? ctx 'module-begin))
-	   (let ([e (local-transformer-expand/capture-lifts
-		     #'elem
-		     ctx
-		     (syntax->list
-		      #'(begin
-			  define-values
-			  define-syntaxes
-			  define-values-for-syntax
-			  set!
-			  let-values
-			  let*-values
-			  letrec-values
-			  lambda
-			  case-lambda
-			  if
-			  quote
-			  letrec-syntaxes+values
-			  fluid-let-syntax
-			  with-continuation-mark
-                          #%expression
-                          #%variable-reference
-			  #%app
-			  #%top
-                          #%provide 
-                          #%require)))])
-	     (syntax-case* e (begin define-values define-syntaxes require require-for-template) 
-			   free-transformer-identifier=?
-	       [(begin (begin v ...))
-		#'(begin-for-syntax v ...)]
-	       [(begin (define-values (id ...) expr))
-		#'(define-values-for-syntax (id ...) expr)]
-	       [(begin (require v ...))
-		#'(require (for-syntax v ...))]
-	       [(begin (define-syntaxes (id ...) expr))
-		(raise-syntax-error
-		 #f
-		 "syntax definitions not allowed within begin-for-syntax"
-		 #'elem)]
-               [(begin other)
-		#'(define-values-for-syntax () (begin other (values)))]
-	       [(begin v ...)
-                #'(begin-for-syntax v ...)]))]
-	  [(_ elem ...)
-	   ;; We split up the elems so that someone else can
-	   ;;  worry about the fact that properly expanding the second
-	   ;;  things might depend somehow on the first thing.
-	   ;; This also avoids a problem when `begin-for-syntax' is the
-	   ;;  only thing in a module body, and `module' has to expand
-	   ;;  it looking for #%module-begin.
-	   (syntax/loc stx (begin (begin-for-syntax elem) ...))])))))
+              (lambda (stx) (go #'define-values-for-syntax stx))))))
diff --git a/collects/racket/private/modbeg.rkt b/collects/racket/private/modbeg.rkt
index d4930d049b..4169926c30 100644
--- a/collects/racket/private/modbeg.rkt
+++ b/collects/racket/private/modbeg.rkt
@@ -61,7 +61,7 @@
                                                  begin begin0 set!
                                                  with-continuation-mark
                                                  if #%app #%expression
-                                                 define-values define-syntaxes define-values-for-syntax
+                                                 define-values define-syntaxes begin-for-syntax
                                                  module 
                                                  #%module-begin 
                                                  #%require #%provide 
@@ -98,7 +98,7 @@
                                                            (free-identifier=? i a))
                                                          (syntax->list
                                                           (quote-syntax 
-                                                           (define-values define-syntaxes define-values-for-syntax
+                                                           (define-values define-syntaxes begin-for-syntax
                                                              module 
                                                              #%module-begin 
                                                              #%require #%provide))))
diff --git a/collects/racket/private/old-rp.rkt b/collects/racket/private/old-rp.rkt
index 74f15547f2..14b78db0c5 100644
--- a/collects/racket/private/old-rp.rkt
+++ b/collects/racket/private/old-rp.rkt
@@ -5,28 +5,29 @@
   (#%provide require require-for-syntax require-for-template require-for-label
              provide provide-for-syntax provide-for-label)
 
-  (define-values-for-syntax (rebuild-elem)
-    (lambda (stx elem sub pos loop ids)
-      ;; For sub-forms, we loop and reconstruct:
-      (for-each (lambda (id)
-                  (unless (identifier? id)
-                    (raise-syntax-error
-                     #f
-                     "expected an identifier"
-                     stx
-                     id)))
-                (syntax->list ids))
-      (let rloop ([elem elem][pos pos])
-        (if (syntax? elem)
-            (datum->syntax elem
-                                  (rloop (syntax-e elem) pos)
-                                  elem
-                                  elem)
-            (if (zero? pos)
-                (cons (loop (car elem))
-                      (cdr elem))
-                (cons (car elem)
-                      (rloop (cdr elem) (sub1 pos))))))))
+  (begin-for-syntax
+   (define-values (rebuild-elem)
+     (lambda (stx elem sub pos loop ids)
+       ;; For sub-forms, we loop and reconstruct:
+       (for-each (lambda (id)
+                   (unless (identifier? id)
+                     (raise-syntax-error
+                      #f
+                      "expected an identifier"
+                      stx
+                      id)))
+                 (syntax->list ids))
+       (let rloop ([elem elem][pos pos])
+         (if (syntax? elem)
+             (datum->syntax elem
+                            (rloop (syntax-e elem) pos)
+                            elem
+                            elem)
+             (if (zero? pos)
+                 (cons (loop (car elem))
+                       (cdr elem))
+                 (cons (car elem)
+                       (rloop (cdr elem) (sub1 pos)))))))))
 
 
   (define-syntaxes (require require-for-syntax require-for-template require-for-label)
diff --git a/collects/racket/private/reqprov.rkt b/collects/racket/private/reqprov.rkt
index fa01fb7792..03a6eee8f2 100644
--- a/collects/racket/private/reqprov.rkt
+++ b/collects/racket/private/reqprov.rkt
@@ -636,36 +636,41 @@
      (lambda (stx modes)
        (syntax-case stx ()
          [(_) 
-          (let-values ([(ids stx-ids) (syntax-local-module-defined-identifiers)]
-                       [(same-ctx?) (lambda (free-identifier=?)
-                                      (lambda (id)
-                                        (free-identifier=? id
-                                                           (datum->syntax
-                                                            stx
-                                                            (syntax-e id)))))])
-            (append
-             (if (memq 1 modes)
-                 (map (lambda (id)
-                        (make-export id (syntax-e id) 1 #f stx))
-                      (filter (same-ctx? free-transformer-identifier=?)
-                              stx-ids))
-                 null)
-             (if (or (null? modes)
-                     (memq 0 modes))
-                 (map (lambda (id)
-                        (make-export id (syntax-e id) 0 #f stx))
-                      (filter (lambda (id)
-                                (and ((same-ctx? free-identifier=?) id)
-                                     (let-values ([(v id) (syntax-local-value/immediate
-                                                           id
-                                                           (lambda () (values #f #f)))])
-                                       (not
-                                        (and (rename-transformer? v)
-                                             (syntax-property 
-                                              (rename-transformer-target v)
-                                              'not-provide-all-defined))))))
-                              ids))
-                 null)))]))))
+          (let* ([ht (syntax-local-module-defined-identifiers)]
+                 [same-ctx? (lambda (free-identifier=?)
+                              (lambda (id)
+                                (free-identifier=? id
+                                                   (datum->syntax
+                                                    stx
+                                                    (syntax-e id)))))]
+                 [modes (if (null? modes)
+                            '(0)
+                            modes)])
+            (apply
+             append
+             (map (lambda (mode)
+                    (let* ([phase (and mode (+ mode (syntax-local-phase-level)))]
+                           [same-ctx-in-phase?
+                            (same-ctx? 
+                             (cond
+                              [(eq? mode 0) free-identifier=?]
+                              [(eq? mode 1) free-transformer-identifier=?]
+                              [else (lambda (a b)
+                                      (free-identifier=? a b phase))]))])
+                      (map (lambda (id)
+                             (make-export id (syntax-e id) mode #f stx))
+                           (filter (lambda (id)
+                                     (and (same-ctx-in-phase? id)
+                                          (let-values ([(v id) (syntax-local-value/immediate
+                                                                id
+                                                                (lambda () (values #f #f)))])
+                                            (not
+                                             (and (rename-transformer? v)
+                                                  (syntax-property 
+                                                   (rename-transformer-target v)
+                                                   'not-provide-all-defined))))))
+                                   (hash-ref ht phase null)))))
+                  modes)))]))))
 
   (define-syntax all-from-out
     (make-provide-transformer
@@ -815,7 +820,7 @@
                    (equal? '(0) modes))
          (raise-syntax-error
           #f
-          "allowed only for phase level 0"
+          "allowed only for relative phase level 0"
           stx))
        (syntax-case stx ()
          [(_ id)
@@ -848,13 +853,14 @@
                                           null]
                                          [else (cons (car ids) (loop (cdr ids)))]))))]
                          ;; FIXME: we're building a list of all imports on every expansion
-                         ;; of `syntax-out'. That could become expensive if `syntax-out' is
+                         ;; of `struct-out'. That could become expensive if `struct-out' is
                          ;; used a lot.
-                         [avail-ids (append (let-values ([(ids _) (syntax-local-module-defined-identifiers)])
-                                              ids)
+                         [avail-ids (append (hash-ref (syntax-local-module-defined-identifiers)
+                                                      (syntax-local-phase-level)
+                                                      null)
                                             (let ([idss (syntax-local-module-required-identifiers #f #t)])
                                               (if idss
-                                                  (let ([a (assoc 0 idss)])
+                                                  (let ([a (assoc (syntax-local-phase-level) idss)])
                                                     (if a
                                                         (cdr a)
                                                         null))
diff --git a/collects/racket/private/stxcase-scheme.rkt b/collects/racket/private/stxcase-scheme.rkt
index 5cc44492ba..a3b707b91c 100644
--- a/collects/racket/private/stxcase-scheme.rkt
+++ b/collects/racket/private/stxcase-scheme.rkt
@@ -25,16 +25,17 @@
 	 names)
 	#f)))
 
-  (define-values-for-syntax (check-sr-rules)
-    (lambda (stx kws)
-      (for-each (lambda (id)
-                  (unless (identifier? id)
-                    (raise-syntax-error
-                     #f
-                     "pattern must start with an identifier, found something else"
-                     stx
-                     id)))
-                (syntax->list kws))))
+  (begin-for-syntax
+   (define-values (check-sr-rules)
+     (lambda (stx kws)
+       (for-each (lambda (id)
+                   (unless (identifier? id)
+                     (raise-syntax-error
+                      #f
+                      "pattern must start with an identifier, found something else"
+                      stx
+                      id)))
+                 (syntax->list kws)))))
   
   ;; From Dybvig, mostly:
   (-define-syntax syntax-rules
diff --git a/collects/racket/vector.rkt b/collects/racket/vector.rkt
index 925748c886..e53e8e47e9 100644
--- a/collects/racket/vector.rkt
+++ b/collects/racket/vector.rkt
@@ -231,7 +231,7 @@
 (define-syntax-rule (vm-mk name cmp)
   (define (name val vec)
     (unless (vector? vec)
-      (raise-type-error 'name "vector" 1 vec))
+      (raise-type-error 'name "vector" 1 val vec))
     (let ([sz (unsafe-vector-length vec)])
       (let loop ([k 0])
         (cond [(= k sz) #f]
diff --git a/collects/rackunit/tool.rkt b/collects/rackunit/tool.rkt
index ba75e1a362..230df69fd4 100644
--- a/collects/rackunit/tool.rkt
+++ b/collects/rackunit/tool.rkt
@@ -3,8 +3,7 @@
          racket/gui/base
          framework
          drscheme/tool
-         racket/unit
-         (prefix-in drlink: "private/gui/drracket-link.rkt"))
+         racket/unit)
 
 (provide tool@)
 
@@ -13,8 +12,6 @@
 (define BACKTRACE-NO-MESSAGE "No message.")
 (define LINK-MODULE-SPEC 'rackunit/private/gui/drracket-link)
 
-(define-namespace-anchor drracket-ns-anchor)
-
 ;; ----
 
 ;; close/eventspace : (a* -> b) -> (a* -> b)
@@ -63,25 +60,17 @@
          (drscheme:debug:open-and-highlight-in-file
           (list (make-srcloc src #f #f pos span))))))
 
-    ;; Send them off to the drscheme-ui module.
-    ;; We'll still have to attach our instantiation of drscheme-link
-    ;; to the user namespace.
-    (set-box! drlink:link
-              (vector get-errortrace-backtrace
-                      show-backtrace
-                      show-source))
-
-    (define drracket-ns (namespace-anchor->namespace drracket-ns-anchor))
-
     (define interactions-text-mixin
       (mixin ((class->interface drscheme:rep:text%)) ()
         (inherit get-user-namespace)
         (super-new)
 
         (define/private (setup-helper-module)
-          (namespace-attach-module drracket-ns
-                                   LINK-MODULE-SPEC
-                                   (get-user-namespace)))
+          (let ([link (parameterize ((current-namespace (get-user-namespace)))
+                        (dynamic-require LINK-MODULE-SPEC 'link))])
+            (set-box! link (vector get-errortrace-backtrace
+                                   show-backtrace
+                                   show-source))))
 
         (define/override (reset-console)
           (super reset-console)
diff --git a/collects/redex/private/defined-checks.rkt b/collects/redex/private/defined-checks.rkt
index 261866f2ab..8861097b8c 100644
--- a/collects/redex/private/defined-checks.rkt
+++ b/collects/redex/private/defined-checks.rkt
@@ -14,4 +14,4 @@
     (thunk)))
 
 (define (report-undefined name desc)
-  (redex-error #f "~a ~s applied before its definition" desc name))
\ No newline at end of file
+  (redex-error #f "reference to ~a ~s before its definition" desc name))
\ No newline at end of file
diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt
index c2f3bfc6a6..fcfca2f1d8 100644
--- a/collects/redex/private/reduction-semantics.rkt
+++ b/collects/redex/private/reduction-semantics.rkt
@@ -328,7 +328,7 @@
               [env (make-immutable-hash
                     (map (λ (x e) (cons (syntax-e x) e))
                          names w/ellipses))])
-     (syntax-case stx (fresh)
+     (syntax-case stx (fresh judgment-holds)
        [() body]
        [((-where x e) y ...)
         (where-keyword? #'-where)
@@ -390,6 +390,8 @@
                         (verify-names-ok '#,orig-name the-names len-counter)
                         (variables-not-in #,to-not-be-in the-names))])
                     #,(loop #'(z ...) #`(list (term (y #,'...)) #,to-not-be-in) env))]
+       [((judgment-holds j) . after)
+        (loop (cons #'j #'after) to-not-be-in env)]
        [((form-name . pats) . after)
         (judgment-form-id? #'form-name)
         (let*-values ([(premise) (syntax-case stx () [(p . _) #'p])]
@@ -1331,10 +1333,6 @@
     (map (λ (x) (to-lw/proc (datum->syntax #f (cdr (syntax-e x)) x)))
          (syntax->list #'(lhs-for-lw ...)))))
 
-(define-for-syntax (not-expression-context stx)
-  (when (eq? (syntax-local-context) 'expression)
-    (raise-syntax-error #f "not allowed in an expression context" stx)))
-
 ;                                                                                                          
 ;                                                                                                          
 ;                                                                                                          
@@ -1351,454 +1349,476 @@
 ;                                                                                                          
 ;                                                                                                          
 
-(define-syntax-set (define-metafunction define-metafunction/extension 
-                     define-relation
-                     define-judgment-form)
-  
-  (define (define-metafunction/proc stx)
-    (syntax-case stx ()
-      [(_ . rest)
-       (internal-define-metafunction stx #f #'rest #f)]))
-  
-  (define (define-relation/proc stx)
-    (syntax-case stx ()
-      [(_ . rest)
-       ;; need to rule out the contracts for this one
-       (internal-define-metafunction stx #f #'rest #t)]))
-  
-  (define (define-metafunction/extension/proc stx)
-    (syntax-case stx ()
-      [(_ prev . rest)
-       (identifier? #'prev)
-       (internal-define-metafunction stx #'prev #'rest #f)]))
-  
-  (define (internal-define-metafunction orig-stx prev-metafunction stx relation?)
-    (not-expression-context orig-stx)
-    (syntax-case stx ()
-      [(lang . rest)
-       (let ([syn-error-name (if relation?
-                                 'define-relation
-                                 (if prev-metafunction
-                                     'define-metafunction/extension
-                                     'define-metafunction))])
-         (define lang-nts
-           ;; keep this near the beginning, so it signals the first error (PR 10062)
-           (definition-nts #'lang orig-stx syn-error-name))
-         (when (null? (syntax-e #'rest))
-           (raise-syntax-error syn-error-name "no clauses" orig-stx))
-         (when prev-metafunction
-           (syntax-local-value 
-            prev-metafunction
-            (λ ()
-              (raise-syntax-error syn-error-name "expected a previously defined metafunction" orig-stx prev-metafunction))))
-         (let*-values ([(contract-name dom-ctcs codom-contracts pats)
-                        (split-out-contract orig-stx syn-error-name #'rest relation?)]
-                       [(name _) (defined-name (list contract-name) pats orig-stx)])
-           (with-syntax ([(((original-names lhs-clauses ...) raw-rhses ...) ...) pats]
-                         [(lhs-for-lw ...) (lhs-lws pats)])
-             (with-syntax ([((rhs stuff ...) ...) (if relation?
-                                                      #'((,(and (term raw-rhses) ...)) ...)
-                                                      #'((raw-rhses ...) ...))])
-               (with-syntax ([(lhs ...) #'((lhs-clauses ...) ...)]
-                             [name name])
-                 (when (and prev-metafunction (eq? (syntax-e #'name) (syntax-e prev-metafunction)))
-                   (raise-syntax-error syn-error-name "the extended and extending metafunctions cannot share a name" orig-stx prev-metafunction))
-                 (parse-extras #'((stuff ...) ...))
-                 (let-values ([(lhs-namess lhs-namess/ellipsess)
-                               (lhss-bound-names (syntax->list (syntax (lhs ...))) lang-nts syn-error-name)])
-                   (with-syntax ([(rhs/wheres ...)
-                                  (map (λ (sc/b rhs names names/ellipses)
-                                         (bind-withs
-                                          syn-error-name '()  
-                                          #'effective-lang lang-nts
-                                          sc/b 'flatten
-                                          #`(list (term #,rhs))
-                                          names names/ellipses))
-                                       (syntax->list #'((stuff ...) ...))
-                                       (syntax->list #'(rhs ...))
-                                       lhs-namess lhs-namess/ellipsess)]
-                                 [(rg-rhs/wheres ...)
-                                  (map (λ (sc/b rhs names names/ellipses) 
-                                         (bind-withs
-                                          syn-error-name '()  
-                                          #'effective-lang lang-nts
-                                          sc/b 'predicate
-                                          #`#t
-                                          names names/ellipses))
-                                       (syntax->list #'((stuff ...) ...))
-                                       (syntax->list #'(rhs ...))
-                                       lhs-namess lhs-namess/ellipsess)])
-                     (with-syntax ([(side-conditions-rewritten ...) 
-                                    (map (λ (x) (rewrite-side-conditions/check-errs
-                                                 lang-nts
-                                                 syn-error-name
-                                                 #t
-                                                 x))
-                                         (syntax->list (syntax (lhs ...))))]
-                                   [(rg-side-conditions-rewritten ...) 
-                                    (map (λ (x) (rewrite-side-conditions/check-errs
-                                                 lang-nts
-                                                 syn-error-name
-                                                 #t
-                                                 x))
-                                         (syntax->list (syntax ((side-condition lhs rg-rhs/wheres) ...))))]
-                                   [(clause-src ...)
-                                    (map (λ (lhs)
-                                           (format "~a:~a:~a"
-                                                   (syntax-source lhs)
-                                                   (syntax-line lhs)
-                                                   (syntax-column lhs)))
-                                         pats)]
-                                   [dom-side-conditions-rewritten
-                                    (and dom-ctcs
-                                         (rewrite-side-conditions/check-errs
-                                          lang-nts
-                                          syn-error-name
-                                          #f
-                                          dom-ctcs))]
-                                   [(codom-side-conditions-rewritten ...)
-                                    (map (λ (codom-contract)
-                                           (rewrite-side-conditions/check-errs
-                                            lang-nts
-                                            syn-error-name
-                                            #f
-                                            codom-contract))
-                                         codom-contracts)]
-                                   [(rhs-fns ...)
-                                    (map (λ (names names/ellipses rhs/where)
-                                           (with-syntax ([(names ...) names]
-                                                         [(names/ellipses ...) names/ellipses]
-                                                         [rhs/where rhs/where])
-                                             (syntax
-                                              (λ (name bindings)
-                                                (term-let-fn ((name name))
-                                                             (term-let ([names/ellipses (lookup-binding bindings 'names)] ...)
-                                                                       rhs/where))))))
-                                         lhs-namess lhs-namess/ellipsess
-                                         (syntax->list (syntax (rhs/wheres ...))))]
-                                   [(name2 name-predicate) (generate-temporaries (syntax (name name)))])
-                       (with-syntax ([defs #`(begin
-                                               (define-values (name2 name-predicate)
-                                                 (let ([sc `(side-conditions-rewritten ...)]
-                                                       [dsc `dom-side-conditions-rewritten])
-                                                   (let ([cases (map (λ (pat rhs-fn rg-lhs src)
-                                                                       (make-metafunc-case
-                                                                        (λ (effective-lang) (compile-pattern effective-lang pat #t))
-                                                                        rhs-fn
-                                                                        rg-lhs src (gensym)))
-                                                                     sc
-                                                                     (list (λ (effective-lang) rhs-fns) ...)
-                                                                     (list (λ (effective-lang) `rg-side-conditions-rewritten) ...)
-                                                                     `(clause-src ...))]
-                                                         [parent-cases 
-                                                          #,(if prev-metafunction
-                                                                #`(metafunc-proc-cases #,(term-fn-get-id (syntax-local-value prev-metafunction)))
-                                                                #'null)])
-                                                     (build-metafunction 
-                                                      lang
-                                                      cases
-                                                      parent-cases
-                                                      (λ (f/dom)
-                                                        (make-metafunc-proc
-                                                         (let ([name (lambda (x) (f/dom x))]) name)
-                                                         (generate-lws #,relation?
-                                                                       (lhs ...)
-                                                                       (lhs-for-lw ...)
-                                                                       ((stuff ...) ...)
-                                                                       #,(if relation?
-                                                                             #'((raw-rhses ...) ...)
-                                                                             #'(rhs ...)))
-                                                         lang
-                                                         #t ;; multi-args?
-                                                         'name
-                                                         (let ([name (lambda (x) (name-predicate x))]) name)
-                                                         dsc
-                                                         (append cases parent-cases)
-                                                         #,relation?))
-                                                      dsc
-                                                      `(codom-side-conditions-rewritten ...)
-                                                      'name
-                                                      #,relation?))))
-                                               (term-define-fn name name2))])
-                         (syntax-property
-                          (prune-syntax
-                           (if (eq? 'top-level (syntax-local-context))
-                               ; Introduce the names before using them, to allow
-                               ; metafunction definition at the top-level.
-                               (syntax 
-                                (begin 
-                                  (define-syntaxes (name2 name-predicate) (values))
-                                  defs))
-                               (syntax defs)))
-                          'disappeared-use
-                          (map syntax-local-introduce 
-                               (syntax->list #'(original-names ...)))))))))))))]))
+(define-syntax (define-metafunction stx)
+  (syntax-case stx ()
+    [(_ . rest)
+     (internal-define-metafunction stx #f #'rest #f)]))
 
-  (define (define-judgment-form/proc stx)
-    (not-expression-context stx)
-    (syntax-case stx ()
-      [(def-form-id lang . body)
-       (let ([lang #'lang]
-             [syn-err-name (syntax-e #'def-form-id)])
-         (define nts (definition-nts lang stx syn-err-name))
-         (define-values (judgment-form-name dup-form-names mode position-contracts clauses)
-           (parse-judgment-form-body #'body syn-err-name stx))
-         (define definitions
-           #`(begin
-               (define-syntax #,judgment-form-name 
-                 (judgment-form '#,judgment-form-name '#,mode #'judgment-form-proc #'#,lang #'judgment-form-lws))
-               (define judgment-form-proc
-                 (compile-judgment-form-proc #,judgment-form-name #,lang #,mode #,clauses #,position-contracts #,stx #,syn-err-name))
-               (define judgment-form-lws
-                 (compiled-judgment-form-lws #,clauses))))
-         (syntax-property
-          (prune-syntax
-           (if (eq? 'top-level (syntax-local-context))
-               ; Introduce the names before using them, to allow
-               ; judgment form definition at the top-level.
-               #`(begin 
-                   (define-syntaxes (judgment-form-proc judgment-form-lws) (values))
-                   #,definitions)
-               definitions))
-          'disappeared-use
-          (map syntax-local-introduce dup-form-names)))]))
-  
-  (define (parse-judgment-form-body body syn-err-name full-stx)
-    (define-syntax-class pos-mode
-      #:literals (I O)
-      (pattern I)
-      (pattern O))
-    (define-syntax-class mode-spec
-      #:description "mode specification"
-      (pattern (_:id _:pos-mode ...)))
-    (define-syntax-class contract-spec
-      #:description "contract specification"
-      (pattern (_:id _:expr ...)))
-    (define (horizontal-line? id)
-      (regexp-match? #rx"^-+$" (symbol->string (syntax-e id))))
-    (define-syntax-class horizontal-line
-      (pattern x:id #:when (horizontal-line? #'x)))
-    (define (parse-rules rules)
-      (for/list ([rule rules])
-        (syntax-parse rule
-          [(prem ... _:horizontal-line conc)
-           #'(conc prem ...)]
-          [_ rule])))
-    (define-values (name/mode mode name/contract contract rules)
-      (syntax-parse body #:context full-stx
-        [((~or (~seq #:mode ~! mode:mode-spec)
-               (~seq #:contract ~! contract:contract-spec))
-          ... . rules:expr)
-         (let-values ([(name/mode mode)
-                       (syntax-parse #'(mode ...)
-                         [((name . mode)) (values #'name (syntax->list #'mode))]
-                         [_ (raise-syntax-error 
-                             #f "expected definition to include a mode specification"
-                             full-stx)])]
-                      [(name/ctc ctc)
-                       (syntax-parse #'(contract ...)
-                         [() (values #f #f)]
-                         [((name . contract)) (values #'name (syntax->list #'contract))]
-                         [(_ . dups)
-                          (raise-syntax-error 
-                           syn-err-name "expected at most one contract specification"
-                           #f #f (syntax->list #'dups))])])
-           (values name/mode mode name/ctc ctc (parse-rules #'rules)))]))
-    (check-clauses full-stx syn-err-name rules #t)
-    (check-arity-consistency mode contract full-stx)
-    (define-values (form-name dup-names)
-      (syntax-case rules ()
-        [() (raise-syntax-error #f "expected at least one rule" full-stx)]
-        [_ (defined-name (list name/mode name/contract) rules full-stx)]))
-    (values form-name dup-names mode contract rules))
-  
-  (define (check-arity-consistency mode contracts full-def)
-    (when (and contracts (not (= (length mode) (length contracts))))
-      (raise-syntax-error 
-       #f "mode and contract specify different numbers of positions" full-def)))
-  
-  (define (lhss-bound-names lhss nts syn-error-name)
-    (let loop ([lhss lhss])
-      (if (null? lhss)
-          (values null null)
-          (let-values ([(namess namess/ellipsess)
-                        (loop (cdr lhss))]
-                       [(names names/ellipses)
-                        (extract-names nts syn-error-name #t (car lhss))])
-            (values (cons names namess)
-                    (cons names/ellipses namess/ellipsess))))))
-  
-  (define (defined-name declared-names clauses orig-stx)
-    (with-syntax ([(((used-names _ ...) _ ...) ...) clauses])
-      (define-values (the-name other-names)
-        (let ([present (filter values declared-names)])
-          (if (null? present)
-              (values (car (syntax->list #'(used-names ...)))
-                      (cdr (syntax->list #'(used-names ...))))
-              (values (car present) 
-                      (append (cdr present) (syntax->list #'(used-names ...)))))))
-      (let loop ([others other-names])
+(define-syntax (define-relation stx)
+  (syntax-case stx ()
+    [(_ . rest)
+     ;; need to rule out the contracts for this one
+     (internal-define-metafunction stx #f #'rest #t)]))
+
+(define-syntax (define-metafunction/extension stx)
+  (syntax-case stx ()
+    [(_ prev . rest)
+     (identifier? #'prev)
+     (internal-define-metafunction stx #'prev #'rest #f)]))
+
+(define-for-syntax (internal-define-metafunction orig-stx prev-metafunction stx relation?)
+  (not-expression-context orig-stx)
+  (syntax-case stx ()
+    [(lang . rest)
+     (let ([syn-error-name (if relation?
+                               'define-relation
+                               (if prev-metafunction
+                                   'define-metafunction/extension
+                                   'define-metafunction))])
+       ;; keep this near the beginning, so it signals the first error (PR 10062)
+       (definition-nts #'lang orig-stx syn-error-name)
+       (when (null? (syntax-e #'rest))
+         (raise-syntax-error syn-error-name "no clauses" orig-stx))
+       (when prev-metafunction
+         (syntax-local-value 
+          prev-metafunction
+          (λ ()
+            (raise-syntax-error syn-error-name "expected a previously defined metafunction" orig-stx prev-metafunction))))
+       (let*-values ([(contract-name dom-ctcs codom-contracts pats)
+                      (split-out-contract orig-stx syn-error-name #'rest relation?)]
+                     [(name _) (defined-name (list contract-name) pats orig-stx)])
+         (when (and prev-metafunction (eq? (syntax-e #'name) (syntax-e prev-metafunction)))
+           (raise-syntax-error syn-error-name "the extended and extending metafunctions cannot share a name" orig-stx prev-metafunction))
+         (with-syntax ([(name2 name-predicate) (generate-temporaries (list name name))]
+                       [name name])
+           (with-syntax ([defs #`(begin
+                                   (define-values (name2 name-predicate)
+                                     (generate-metafunction #,orig-stx
+                                                            lang
+                                                            #,prev-metafunction
+                                                            name
+                                                            name-predicate
+                                                            #,dom-ctcs
+                                                            #,codom-contracts
+                                                            #,pats
+                                                            #,relation?
+                                                            #,syn-error-name))
+                                   (term-define-fn name name2))])
+             (if (eq? 'top-level (syntax-local-context))
+                 ; Introduce the names before using them, to allow
+                 ; metafunction definition at the top-level.
+                 (syntax 
+                  (begin 
+                    (define-syntaxes (name2 name-predicate) (values))
+                    defs))
+                 (syntax defs))))))]))
+
+(define-syntax (generate-metafunction stx)
+  (syntax-case stx ()
+    [(_ orig-stx lang prev-metafunction name name-predicate dom-ctcs codom-contracts pats relation? syn-error-name)
+     (let ([prev-metafunction (and (syntax-e #'prev-metafunction) #'prev-metafunction)]
+           [dom-ctcs (syntax-e #'dom-ctcs)]
+           [codom-contracts (syntax-e #'codom-contracts)]
+           [pats (syntax-e #'pats)]
+           [relation? (syntax-e #'relation?)]
+           [syn-error-name (syntax-e #'syn-err-name)])
+       (define lang-nts
+         (definition-nts #'lang #'orig-stx syn-error-name))
+       (with-syntax ([(((original-names lhs-clauses ...) raw-rhses ...) ...) pats]
+                     [(lhs-for-lw ...) (lhs-lws pats)])
+         (with-syntax ([((rhs stuff ...) ...) (if relation?
+                                                  #'((,(and (term raw-rhses) ...)) ...)
+                                                  #'((raw-rhses ...) ...))]
+                       [(lhs ...) #'((lhs-clauses ...) ...)])
+           (parse-extras #'((stuff ...) ...))
+           (let-values ([(lhs-namess lhs-namess/ellipsess)
+                         (lhss-bound-names (syntax->list (syntax (lhs ...))) lang-nts syn-error-name)])
+             (with-syntax ([(rhs/wheres ...)
+                            (map (λ (sc/b rhs names names/ellipses)
+                                   (bind-withs
+                                    syn-error-name '()  
+                                    #'effective-lang lang-nts
+                                    sc/b 'flatten
+                                    #`(list (term #,rhs))
+                                    names names/ellipses))
+                                 (syntax->list #'((stuff ...) ...))
+                                 (syntax->list #'(rhs ...))
+                                 lhs-namess lhs-namess/ellipsess)]
+                           [(rg-rhs/wheres ...)
+                            (map (λ (sc/b rhs names names/ellipses) 
+                                   (bind-withs
+                                    syn-error-name '()  
+                                    #'effective-lang lang-nts
+                                    sc/b 'predicate
+                                    #`#t
+                                    names names/ellipses))
+                                 (syntax->list #'((stuff ...) ...))
+                                 (syntax->list #'(rhs ...))
+                                 lhs-namess lhs-namess/ellipsess)])
+               (with-syntax ([(side-conditions-rewritten ...) 
+                              (map (λ (x) (rewrite-side-conditions/check-errs
+                                           lang-nts
+                                           syn-error-name
+                                           #t
+                                           x))
+                                   (syntax->list (syntax (lhs ...))))]
+                             [(rg-side-conditions-rewritten ...) 
+                              (map (λ (x) (rewrite-side-conditions/check-errs
+                                           lang-nts
+                                           syn-error-name
+                                           #t
+                                           x))
+                                   (syntax->list (syntax ((side-condition lhs rg-rhs/wheres) ...))))]
+                             [(clause-src ...)
+                              (map (λ (lhs)
+                                     (format "~a:~a:~a"
+                                             (syntax-source lhs)
+                                             (syntax-line lhs)
+                                             (syntax-column lhs)))
+                                   pats)]
+                             [dom-side-conditions-rewritten
+                              (and dom-ctcs
+                                   (rewrite-side-conditions/check-errs
+                                    lang-nts
+                                    syn-error-name
+                                    #f
+                                    dom-ctcs))]
+                             [(codom-side-conditions-rewritten ...)
+                              (map (λ (codom-contract)
+                                     (rewrite-side-conditions/check-errs
+                                      lang-nts
+                                      syn-error-name
+                                      #f
+                                      codom-contract))
+                                   codom-contracts)]
+                             [(rhs-fns ...)
+                              (map (λ (names names/ellipses rhs/where)
+                                     (with-syntax ([(names ...) names]
+                                                   [(names/ellipses ...) names/ellipses]
+                                                   [rhs/where rhs/where])
+                                       (syntax
+                                        (λ (name bindings)
+                                          (term-let-fn ((name name))
+                                                       (term-let ([names/ellipses (lookup-binding bindings 'names)] ...)
+                                                                 rhs/where))))))
+                                   lhs-namess lhs-namess/ellipsess
+                                   (syntax->list (syntax (rhs/wheres ...))))])
+                 (syntax-property
+                  (prune-syntax
+                   #`(let ([sc `(side-conditions-rewritten ...)]
+                           [dsc `dom-side-conditions-rewritten])
+                       (let ([cases (map (λ (pat rhs-fn rg-lhs src)
+                                           (make-metafunc-case
+                                            (λ (effective-lang) (compile-pattern effective-lang pat #t))
+                                            rhs-fn
+                                            rg-lhs src (gensym)))
+                                         sc
+                                         (list (λ (effective-lang) rhs-fns) ...)
+                                         (list (λ (effective-lang) `rg-side-conditions-rewritten) ...)
+                                         `(clause-src ...))]
+                             [parent-cases 
+                              #,(if prev-metafunction
+                                    #`(metafunc-proc-cases #,(term-fn-get-id (syntax-local-value prev-metafunction)))
+                                    #'null)])
+                         (build-metafunction 
+                          lang
+                          cases
+                          parent-cases
+                          (λ (f/dom)
+                            (make-metafunc-proc
+                             (let ([name (lambda (x) (f/dom x))]) name)
+                             (generate-lws #,relation?
+                                           (lhs ...)
+                                           (lhs-for-lw ...)
+                                           ((stuff ...) ...)
+                                           #,(if relation?
+                                                 #'((raw-rhses ...) ...)
+                                                 #'(rhs ...)))
+                             lang
+                             #t ;; multi-args?
+                             'name
+                             (let ([name (lambda (x) (name-predicate x))]) name)
+                             dsc
+                             (append cases parent-cases)
+                             #,relation?))
+                          dsc
+                          `(codom-side-conditions-rewritten ...)
+                          'name
+                          #,relation?))))
+                  'disappeared-use
+                  (map syntax-local-introduce 
+                       (syntax->list #'(original-names ...))))))))))]))
+
+(define-syntax (define-judgment-form stx)
+  (not-expression-context stx)
+  (syntax-case stx ()
+    [(def-form-id lang . body)
+     (let ([lang #'lang]
+           [syn-err-name (syntax-e #'def-form-id)])
+       (define nts (definition-nts lang stx syn-err-name))
+       (define-values (judgment-form-name dup-form-names mode position-contracts clauses)
+         (parse-judgment-form-body #'body syn-err-name stx))
+       (define definitions
+         #`(begin
+             (define-syntax #,judgment-form-name 
+               (judgment-form '#,judgment-form-name '#,mode #'judgment-form-proc #'#,lang #'judgment-form-lws))
+             (define judgment-form-proc
+               (compile-judgment-form-proc #,judgment-form-name #,lang #,mode #,clauses #,position-contracts #,stx #,syn-err-name))
+             (define judgment-form-lws
+               (compiled-judgment-form-lws #,clauses))))
+       (syntax-property
+        (prune-syntax
+         (if (eq? 'top-level (syntax-local-context))
+             ; Introduce the names before using them, to allow
+             ; judgment form definition at the top-level.
+             #`(begin 
+                 (define-syntaxes (judgment-form-proc judgment-form-lws) (values))
+                 #,definitions)
+             definitions))
+        'disappeared-use
+        (map syntax-local-introduce dup-form-names)))]))
+
+(define-for-syntax (parse-judgment-form-body body syn-err-name full-stx)
+  (define-syntax-class pos-mode
+    #:literals (I O)
+    (pattern I)
+    (pattern O))
+  (define-syntax-class mode-spec
+    #:description "mode specification"
+    (pattern (_:id _:pos-mode ...)))
+  (define-syntax-class contract-spec
+    #:description "contract specification"
+    (pattern (_:id _:expr ...)))
+  (define (horizontal-line? id)
+    (regexp-match? #rx"^-+$" (symbol->string (syntax-e id))))
+  (define-syntax-class horizontal-line
+    (pattern x:id #:when (horizontal-line? #'x)))
+  (define (parse-rules rules)
+    (for/list ([rule rules])
+      (syntax-parse rule
+        [(prem ... _:horizontal-line conc)
+         #'(conc prem ...)]
+        [_ rule])))
+  (define-values (name/mode mode name/contract contract rules)
+    (syntax-parse body #:context full-stx
+      [((~or (~seq #:mode ~! mode:mode-spec)
+             (~seq #:contract ~! contract:contract-spec))
+        ... . rules:expr)
+       (let-values ([(name/mode mode)
+                     (syntax-parse #'(mode ...)
+                       [((name . mode)) (values #'name (syntax->list #'mode))]
+                       [_ (raise-syntax-error 
+                           #f "expected definition to include a mode specification"
+                           full-stx)])]
+                    [(name/ctc ctc)
+                     (syntax-parse #'(contract ...)
+                       [() (values #f #f)]
+                       [((name . contract)) (values #'name (syntax->list #'contract))]
+                       [(_ . dups)
+                        (raise-syntax-error 
+                         syn-err-name "expected at most one contract specification"
+                         #f #f (syntax->list #'dups))])])
+         (values name/mode mode name/ctc ctc (parse-rules #'rules)))]))
+  (check-clauses full-stx syn-err-name rules #t)
+  (check-arity-consistency mode contract full-stx)
+  (define-values (form-name dup-names)
+    (syntax-case rules ()
+      [() (raise-syntax-error #f "expected at least one rule" full-stx)]
+      [_ (defined-name (list name/mode name/contract) rules full-stx)]))
+  (values form-name dup-names mode contract rules))
+
+(define-for-syntax (check-arity-consistency mode contracts full-def)
+  (when (and contracts (not (= (length mode) (length contracts))))
+    (raise-syntax-error 
+     #f "mode and contract specify different numbers of positions" full-def)))
+
+(define-for-syntax (lhss-bound-names lhss nts syn-error-name)
+  (let loop ([lhss lhss])
+    (if (null? lhss)
+        (values null null)
+        (let-values ([(namess namess/ellipsess)
+                      (loop (cdr lhss))]
+                     [(names names/ellipses)
+                      (extract-names nts syn-error-name #t (car lhss))])
+          (values (cons names namess)
+                  (cons names/ellipses namess/ellipsess))))))
+
+(define-for-syntax (defined-name declared-names clauses orig-stx)
+  (with-syntax ([(((used-names _ ...) _ ...) ...) clauses])
+    (define-values (the-name other-names)
+      (let ([present (filter values declared-names)])
+        (if (null? present)
+            (values (car (syntax->list #'(used-names ...)))
+                    (cdr (syntax->list #'(used-names ...))))
+            (values (car present) 
+                    (append (cdr present) (syntax->list #'(used-names ...)))))))
+    (let loop ([others other-names])
+      (cond
+        [(null? others) (values the-name other-names)]
+        [else
+         (unless (eq? (syntax-e the-name) (syntax-e (car others)))
+           (raise-syntax-error 
+            #f
+            "expected the same name in both positions"
+            orig-stx
+            the-name (list (car others))))
+         (loop (cdr others))]))))
+
+(define-for-syntax (split-out-contract stx syn-error-name rest relation?)
+  ;; initial test determines if a contract is specified or not
+  (cond
+    [(pair? (syntax-e (car (syntax->list rest))))
+     (values #f #f (list #'any) (check-clauses stx syn-error-name (syntax->list rest) relation?))]
+    [else
+     (syntax-case rest ()
+       [(id separator more ...)
+        (identifier? #'id)
         (cond
-          [(null? others) (values the-name other-names)]
+          [relation?
+           (let-values ([(contract clauses) 
+                         (parse-relation-contract #'(separator more ...) syn-error-name stx)])
+             (when (null? clauses)
+               (raise-syntax-error syn-error-name 
+                                   "expected clause definitions to follow domain contract"
+                                   stx))
+             (values #'id contract (list #'any) (check-clauses stx syn-error-name clauses #t)))]
           [else
-           (unless (eq? (syntax-e the-name) (syntax-e (car others)))
-             (raise-syntax-error 
-              #f
-              "expected the same name in both positions"
-              orig-stx
-              the-name (list (car others))))
-           (loop (cdr others))]))))
-  
-  (define (split-out-contract stx syn-error-name rest relation?)
-    ;; initial test determines if a contract is specified or not
-    (cond
-      [(pair? (syntax-e (car (syntax->list rest))))
-       (values #f #f (list #'any) (check-clauses stx syn-error-name (syntax->list rest) relation?))]
-      [else
-       (syntax-case rest ()
-         [(id separator more ...)
-          (identifier? #'id)
-          (cond
-            [relation?
-             (let-values ([(contract clauses) 
-                           (parse-relation-contract #'(separator more ...) syn-error-name stx)])
-               (when (null? clauses)
-                 (raise-syntax-error syn-error-name 
-                                     "expected clause definitions to follow domain contract"
-                                     stx))
-               (values #'id contract (list #'any) (check-clauses stx syn-error-name clauses #t)))]
-            [else
-             (unless (eq? ': (syntax-e #'separator))
-               (raise-syntax-error syn-error-name "expected a colon to follow the meta-function's name" stx #'separator))
-             (let loop ([more (syntax->list #'(more ...))]
-                        [dom-pats '()])
-               (cond
-                 [(null? more)
-                  (raise-syntax-error syn-error-name "expected an ->" stx)]
-                 [(eq? (syntax-e (car more)) '->)
-                  (define-values (raw-clauses rev-codomains)
-                    (let loop ([prev (car more)]
-                               [more (cdr more)]
-                               [codomains '()])
-                      (cond
-                        [(null? more)
-                         (raise-syntax-error syn-error-name "expected a range contract to follow" stx prev)]
-                        [else
-                         (define after-this-one (cdr more))
-                         (cond
-                           [(null? after-this-one)
-                            (values null (cons (car more) codomains))]
-                           [else
-                            (define kwd (cadr more))
-                            (cond
-                              [(member (syntax-e kwd) '(or ∨ ∪))
-                               (loop kwd 
-                                     (cddr more)
-                                     (cons (car more) codomains))]
-                              [else
-                               (values (cdr more)
-                                       (cons (car more) codomains))])])])))
-                  (let ([doms (reverse dom-pats)]
-                        [clauses (check-clauses stx syn-error-name raw-clauses relation?)])
-                    (values #'id doms (reverse rev-codomains) clauses))]
-                 [else
-                  (loop (cdr more) (cons (car more) dom-pats))]))])]
-         [_
-          (raise-syntax-error
-           syn-error-name
-           (format "expected the name of the ~a, followed by its contract (or no name and no contract)"
-                   (if relation? "relation" "meta-function"))
-           stx
-           rest)])]))
-           
-  (define (check-clauses stx syn-error-name rest relation?)
-    (syntax-case rest ()
-      [([(lhs ...) roc1 roc2 ...] ...)
-       rest]
-      [([(lhs ...) rhs ...] ...)
-       (if relation?
-           rest
-           (begin
-             (for-each 
-              (λ (clause)
-                (syntax-case clause ()
-                  [(a b) (void)]
-                  [x (raise-syntax-error syn-error-name "expected a pattern and a right-hand side" stx clause)]))
-              rest)
-             (raise-syntax-error syn-error-name "error checking failed.3" stx)))]
-      [([x roc ...] ...)
-       (begin
-         (for-each 
-          (λ (x)
-            (syntax-case x ()
-              [(lhs ...) (void)]
-              [x (raise-syntax-error syn-error-name "expected a function prototype" stx #'x)]))
-          (syntax->list #'(x ...)))
-         (raise-syntax-error syn-error-name "error checking failed.1" stx))]
-      [(x ...)
-       (begin
-         (for-each 
-          (λ (x)
-            (syntax-case x ()
-              [(stuff ...) (void)]
-              [x (raise-syntax-error syn-error-name "expected a clause" stx #'x)]))
-          (syntax->list #'(x ...)))
-         (raise-syntax-error syn-error-name "error checking failed.2" stx))]))
-  
-  (define (parse-extras extras)
-    (for-each
-     (λ (stuffs)
-       (for-each
-        (λ (stuff)
-          (syntax-case stuff (where side-condition where/hidden side-condition/hidden)
-            [(side-condition tl-side-conds ...) 
-             (void)]
-            [(side-condition/hidden tl-side-conds ...) 
-             (void)]
-            [(where x e)
-             (void)]
-            [(where/hidden x e)
-             (void)]
-            [(where . args)
-             (raise-syntax-error 'define-metafunction 
-                                 "malformed where clause"
-                                 stuff)]
-            [(where/hidden . args)
-             (raise-syntax-error 'define-metafunction 
-                                 "malformed where/hidden clause"
-                                 stuff)]
-            [_
-             (raise-syntax-error 'define-metafunction 
-                                 "expected a side-condition or where clause"
-                                 stuff)]))
-        (syntax->list stuffs)))
-     (syntax->list extras)))
-  
-  (define (parse-relation-contract after-name syn-error-name orig-stx)
-    (syntax-case after-name ()
-      [(subset . rest-pieces)
-       (unless (memq (syntax-e #'subset) '(⊂ ⊆))
-         (raise-syntax-error syn-error-name
-                             "expected ⊂ or ⊆ to follow the relation's name"
-                             orig-stx #'subset))
-       (let ([more (syntax->list #'rest-pieces)])
-         (when (null? more)
-           (raise-syntax-error syn-error-name 
-                               (format "expected a sequence of patterns separated by x or × to follow ~a" 
-                                       (syntax-e #'subset))
-                               orig-stx
-                               #'subset))
-         (let loop ([more (cdr more)]
-                    [arg-pats (list (car more))])
-           (cond
-             [(and (not (null? more)) (memq (syntax-e (car more)) '(x ×)))
-              (when (null? (cdr more))
-                (raise-syntax-error syn-error-name 
-                                    (format "expected a pattern to follow ~a" (syntax-e (car more)))
-                                    orig-stx (car more)))
-              (loop (cddr more)
-                    (cons (cadr more) arg-pats))]
-             [else (values (reverse arg-pats) more)])))])))
+           (unless (eq? ': (syntax-e #'separator))
+             (raise-syntax-error syn-error-name "expected a colon to follow the meta-function's name" stx #'separator))
+           (let loop ([more (syntax->list #'(more ...))]
+                      [dom-pats '()])
+             (cond
+               [(null? more)
+                (raise-syntax-error syn-error-name "expected an ->" stx)]
+               [(eq? (syntax-e (car more)) '->)
+                (define-values (raw-clauses rev-codomains)
+                  (let loop ([prev (car more)]
+                             [more (cdr more)]
+                             [codomains '()])
+                    (cond
+                      [(null? more)
+                       (raise-syntax-error syn-error-name "expected a range contract to follow" stx prev)]
+                      [else
+                       (define after-this-one (cdr more))
+                       (cond
+                         [(null? after-this-one)
+                          (values null (cons (car more) codomains))]
+                         [else
+                          (define kwd (cadr more))
+                          (cond
+                            [(member (syntax-e kwd) '(or ∨ ∪))
+                             (loop kwd 
+                                   (cddr more)
+                                   (cons (car more) codomains))]
+                            [else
+                             (values (cdr more)
+                                     (cons (car more) codomains))])])])))
+                (let ([doms (reverse dom-pats)]
+                      [clauses (check-clauses stx syn-error-name raw-clauses relation?)])
+                  (values #'id doms (reverse rev-codomains) clauses))]
+               [else
+                (loop (cdr more) (cons (car more) dom-pats))]))])]
+       [_
+        (raise-syntax-error
+         syn-error-name
+         (format "expected the name of the ~a, followed by its contract (or no name and no contract)"
+                 (if relation? "relation" "meta-function"))
+         stx
+         rest)])]))
+
+(define-for-syntax (check-clauses stx syn-error-name rest relation?)
+  (syntax-case rest ()
+    [([(lhs ...) roc1 roc2 ...] ...)
+     rest]
+    [([(lhs ...) rhs ...] ...)
+     (if relation?
+         rest
+         (begin
+           (for-each 
+            (λ (clause)
+              (syntax-case clause ()
+                [(a b) (void)]
+                [x (raise-syntax-error syn-error-name "expected a pattern and a right-hand side" stx clause)]))
+            rest)
+           (raise-syntax-error syn-error-name "error checking failed.3" stx)))]
+    [([x roc ...] ...)
+     (begin
+       (for-each 
+        (λ (x)
+          (syntax-case x ()
+            [(lhs ...) (void)]
+            [x (raise-syntax-error syn-error-name "expected a function prototype" stx #'x)]))
+        (syntax->list #'(x ...)))
+       (raise-syntax-error syn-error-name "error checking failed.1" stx))]
+    [(x ...)
+     (begin
+       (for-each 
+        (λ (x)
+          (syntax-case x ()
+            [(stuff ...) (void)]
+            [x (raise-syntax-error syn-error-name "expected a clause" stx #'x)]))
+        (syntax->list #'(x ...)))
+       (raise-syntax-error syn-error-name "error checking failed.2" stx))]))
+
+(define-for-syntax (parse-extras extras)
+  (for-each
+   (λ (stuffs)
+     (for-each
+      (λ (stuff)
+        (syntax-case stuff (where side-condition where/hidden side-condition/hidden judgment-holds)
+          [(side-condition tl-side-conds ...) 
+           (void)]
+          [(side-condition/hidden tl-side-conds ...) 
+           (void)]
+          [(where x e)
+           (void)]
+          [(where/hidden x e)
+           (void)]
+          [(where . args)
+           (raise-syntax-error 'define-metafunction 
+                               "malformed where clause"
+                               stuff)]
+          [(where/hidden . args)
+           (raise-syntax-error 'define-metafunction 
+                               "malformed where/hidden clause"
+                               stuff)]
+          [(judgment-holds (form-name . _))
+           (unless (judgment-form-id? #'form-name)
+             (raise-syntax-error 'define-metafunction
+                                 "expected the name of a judgment-form"
+                                 #'form-name))]
+          [_
+           (raise-syntax-error 'define-metafunction 
+                               "expected a side-condition or where clause"
+                               stuff)]))
+      (syntax->list stuffs)))
+   (syntax->list extras)))
+
+(define-for-syntax (parse-relation-contract after-name syn-error-name orig-stx)
+  (syntax-case after-name ()
+    [(subset . rest-pieces)
+     (unless (memq (syntax-e #'subset) '(⊂ ⊆))
+       (raise-syntax-error syn-error-name
+                           "expected ⊂ or ⊆ to follow the relation's name"
+                           orig-stx #'subset))
+     (let ([more (syntax->list #'rest-pieces)])
+       (when (null? more)
+         (raise-syntax-error syn-error-name 
+                             (format "expected a sequence of patterns separated by x or × to follow ~a" 
+                                     (syntax-e #'subset))
+                             orig-stx
+                             #'subset))
+       (let loop ([more (cdr more)]
+                  [arg-pats (list (car more))])
+         (cond
+           [(and (not (null? more)) (memq (syntax-e (car more)) '(x ×)))
+            (when (null? (cdr more))
+              (raise-syntax-error syn-error-name 
+                                  (format "expected a pattern to follow ~a" (syntax-e (car more)))
+                                  orig-stx (car more)))
+            (loop (cddr more)
+                  (cons (cadr more) arg-pats))]
+           [else (values (reverse arg-pats) more)])))]))
 
 (define-syntax (judgment-holds stx)
   (syntax-case stx ()
@@ -1863,16 +1883,6 @@
         (for/fold ([outputs '()]) ([rule (list clause-proc ...)])
                   (append (rule input) outputs)))))
 
-(define-for-syntax (in-order-non-hidden extras)
-  (reverse 
-   (filter (λ (extra)
-             (syntax-case extra (where/hidden
-                               side-condition/hidden)
-               [(where/hidden pat exp) #f]
-               [(side-condition/hidden x) #f]
-               [_ #t])) 
-           (syntax->list extras))))
-
 (define-for-syntax (do-compile-judgment-form-lws clauses)
   (syntax-case clauses ()
     [(((_ . conc-body) . prems) ...)
@@ -1899,15 +1909,18 @@
             (loop (cdr rest-modes) rest-terms rest-ctcs (+ 1 pos)))))))
 
 (define-for-syntax (mode-check mode clauses nts syn-err-name)
-  (define ((check-template named-vars) temp bound)
+  (define ((check-template bound-anywhere) temp bound)
     (let check ([t temp])
       (syntax-case t (unquote)
         [(unquote . _)
          (raise-syntax-error syn-err-name "unquote unsupported" t)]
         [x
          (identifier? #'x)
-         (when (and (or (id-binds? nts #t #'x) (free-id-table-ref named-vars #'x #f))
-                    (not (free-id-table-ref bound #'x #f)))
+         (unless (cond [(free-id-table-ref bound-anywhere #'x #f)
+                        (free-id-table-ref bound #'x #f)]
+                       [(id-binds? nts #t #'x)
+                        (term-fn? (syntax-local-value #'x (λ () #f)))]
+                       [else #t])
            (raise-syntax-error syn-err-name "unbound pattern variable" #'x))]
         [(u ...)
          (for-each check (syntax->list #'(u ...)))]
@@ -1960,12 +1973,9 @@
   (for ([clause clauses])
        (define do-tmpl
          (check-template
-          (fold-clause (bind 'name-only) void (make-immutable-free-id-table) clause)))
+          (fold-clause (bind 'rhs-only) void (make-immutable-free-id-table) clause)))
        (fold-clause (bind 'rhs-only) do-tmpl (make-immutable-free-id-table) clause)))
 
-;; Defined as a macro instead of an ordinary phase 1 function so that the
-;; to-lw/proc calls occur after bindings are established for all meta-functions
-;; and relations.
 (define-syntax (generate-lws stx)
   (syntax-case stx ()
     [(_ relation? seq-of-lhs seq-of-lhs-for-lw seq-of-tl-side-cond/binds seq-of-rhs)
@@ -1984,6 +1994,9 @@
                   (map
                    (λ (lst)
                      (syntax-case lst (unquote side-condition where)
+                       [(form-name . _)
+                        (judgment-form-id? #'form-name)
+                        #`(make-metafunc-extra-side-cond #,(to-lw/proc lst))]
                        [(form-name . _)
                         (judgment-form-id? #'form-name)
                         #`(make-metafunc-extra-side-cond #,(to-lw/proc lst))]
@@ -2008,11 +2021,11 @@
                        [maybe-ellipsis
                         (ellipsis? #'maybe-ellipsis)
                         (to-lw/proc #'maybe-ellipsis)]))
-                   (in-order-non-hidden hm)))
+                   (visible-extras hm)))
                 (syntax->list #'seq-of-tl-side-cond/binds))]
           [(((where-bind-id/lw . where-bind-pat/lw) ...) ...)
            (map (λ (clauses)
-                  (for/fold ([binds '()]) ([clause (in-order-non-hidden clauses)])
+                  (for/fold ([binds '()]) ([clause (visible-extras clauses)])
                             (syntax-case clause (where)
                               [(form-name . pieces)
                                (judgment-form-id? #'form-name)
@@ -2038,6 +2051,17 @@
                      rhs/lw)
                ...))]))
 
+(define-for-syntax (visible-extras extras)
+  (for/fold ([visible empty]) ([extra (syntax->list extras)])
+            (syntax-case extra (where/hidden
+                                side-condition/hidden
+                                judgment-holds)
+              [(where/hidden pat exp) visible]
+              [(side-condition/hidden x) visible]
+              [(judgment-holds judgment)
+               (cons #'judgment visible)]
+              [_ (cons extra visible)])))
+
 (define-syntax (compile-judgment-form-proc stx)
   (syntax-case stx ()
     [(_ judgment-form-name lang mode clauses ctcs full-def syn-err-name)
diff --git a/collects/redex/private/rewrite-side-conditions.rkt b/collects/redex/private/rewrite-side-conditions.rkt
index 577402c8a5..57d0413ea6 100644
--- a/collects/redex/private/rewrite-side-conditions.rkt
+++ b/collects/redex/private/rewrite-side-conditions.rkt
@@ -161,8 +161,7 @@
                  (and (identifier? (syntax x))
                       ((case mode
                          [(rhs-only) binds-in-right-hand-side?]
-                         [(binds-anywhere) binds?]
-                         [(name-only) (λ (_1 _2 _3) #f)])
+                         [(binds-anywhere) binds?])
                        all-nts bind-names? (syntax x)))
                  (cons (make-id/depth (syntax x) depth) names)]
                 [else names]))]
diff --git a/collects/redex/private/term-fn.rkt b/collects/redex/private/term-fn.rkt
index 1440fe2efb..3deb9c1b04 100644
--- a/collects/redex/private/term-fn.rkt
+++ b/collects/redex/private/term-fn.rkt
@@ -7,7 +7,10 @@
          (struct-out term-id)
          (struct-out judgment-form)
          judgment-form-id?
-         defined-check)
+         (struct-out defined-term)
+         defined-term-id?
+         defined-check
+         not-expression-context)
 
 (define-values (struct-type make-term-fn term-fn? term-fn-get term-fn-set!) 
   (make-struct-type 'term-fn #f 1 0))
@@ -15,13 +18,24 @@
 
 (define-struct term-id (id depth))
 
-(define-struct judgment-form (name mode proc lang lws))
-
-(define (judgment-form-id? stx)
+(define ((transformer-predicate p?) stx)
   (and (identifier? stx)
-       (judgment-form? (syntax-local-value stx (λ () 'not-a-judgment-form)))))
+       (cond [(syntax-local-value stx (λ () #f)) => p?]
+             [else #f])))
+
+(define-struct judgment-form (name mode proc lang lws))
+(define judgment-form-id? 
+  (transformer-predicate judgment-form?))
+
+(define-struct defined-term (value))
+(define defined-term-id?
+  (transformer-predicate defined-term?))
 
 (define (defined-check id desc #:external [external id])
   (if (eq? (identifier-binding id) 'lexical)
       (quasisyntax/loc external (check-defined-lexical #,id '#,external #,desc))
-      (quasisyntax/loc external (check-defined-module (λ () #,id) '#,external #,desc))))
\ No newline at end of file
+      (quasisyntax/loc external (check-defined-module (λ () #,id) '#,external #,desc))))
+
+(define (not-expression-context stx)
+  (when (eq? (syntax-local-context) 'expression)
+    (raise-syntax-error #f "not allowed in an expression context" stx)))
\ No newline at end of file
diff --git a/collects/redex/private/term.rkt b/collects/redex/private/term.rkt
index a64a39d00c..b6e6f0602c 100644
--- a/collects/redex/private/term.rkt
+++ b/collects/redex/private/term.rkt
@@ -3,11 +3,14 @@
 (require (for-syntax scheme/base 
                      "term-fn.rkt"
                      syntax/boundmap
+                     syntax/parse
                      racket/syntax)
          "error.rkt"
          "matcher.rkt")
 
-(provide term term-let term-let/error-name term-let-fn term-define-fn hole in-hole)
+(provide term term-let define-term
+         hole in-hole
+         term-let/error-name term-let-fn term-define-fn)
 
 (define-syntax (hole stx) (raise-syntax-error 'hole "used outside of term"))
 (define-syntax (in-hole stx) (raise-syntax-error 'in-hole "used outside of term"))
@@ -69,6 +72,15 @@
        (let ([id (syntax-local-value/record (syntax x) (λ (x) #t))])
          (values (datum->syntax (term-id-id id) (syntax-e (term-id-id id)) (syntax x))
                  (term-id-depth id)))]
+      [x
+       (defined-term-id? #'x)
+       (let ([ref (syntax-property
+                   (defined-term-value (syntax-local-value #'x))
+                   'disappeared-use #'x)])
+         (with-syntax ([v #`(begin
+                              #,(defined-check ref "term" #:external #'x)
+                              #,ref)])
+           (values #'#,v 0)))]
       [(unquote x)
        (values (syntax (unsyntax x)) 0)]
       [(unquote . x)
@@ -208,3 +220,11 @@
       (term-let/error-name term-let ((x rhs) ...) body1 body2 ...))]
     [(_ x)
      (raise-syntax-error 'term-let "expected at least one body" stx)]))
+
+(define-syntax (define-term stx)
+  (syntax-parse stx
+    [(_ x:id t:expr)
+     (not-expression-context stx)
+     #'(begin
+         (define term-val (term t))
+         (define-syntax x (defined-term #'term-val)))]))
\ No newline at end of file
diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index 2ff16ed1c8..7b94318b28 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -421,8 +421,8 @@ stands for repetition unless otherwise indicated):
 
 @item{A term written @racket[_identifier] is equivalent to the
 corresponding symbol, unless the identifier is bound by
-@racket[term-let] (or in a @|pattern| elsewhere) or is
-@tt{hole} (as below).  }
+@racket[term-let], @racket[define-term], or a @|pattern| variable or
+the identifier is @tt{hole} (as below).}
 
 @item{A term written @racket[(_term-sequence ...)] constructs a list of
 the terms constructed by the sequence elements.}
@@ -532,6 +532,9 @@ In some contexts, it may be more efficient to use @racket[term-match/single]
 The @racket[let*] analog of @racket[redex-let].
 }
 
+@defform[(define-term identifier @#,tttterm)]{
+Defines @racket[identifier] for use in @|tterm| templates.}
+
 @defform[(term-match language [@#,ttpattern expression] ...)]{
 
 This produces a procedure that accepts term (or quoted)
@@ -703,7 +706,7 @@ otherwise.
                        (fresh fresh-clause ...)
                        (side-condition racket-expression)
                        (where @#,ttpattern @#,tttterm)
-                       (judgment-holds (judgment-form-id pat/term))
+                       (judgment-holds (judgment-form-id pat/term ...))
                        (side-condition/hidden racket-expression)
                        (where/hidden @#,ttpattern @#,tttterm)]
                [shortcuts (code:line)
@@ -957,7 +960,10 @@ it is traversing through the reduction graph.
 
 @declare-exporting[redex/reduction-semantics redex]
 
-@defform/subs[#:literals (: -> where side-condition side-condition/hidden where/hidden)
+@defform/subs[#:literals (: -> 
+                          where side-condition 
+                          side-condition/hidden where/hidden 
+                          judgment-holds)
              (define-metafunction language
                metafunction-contract
                [(name @#,ttpattern ...) @#,tttterm extras ...] 
@@ -971,7 +977,9 @@ it is traversing through the reduction graph.
               [extras (side-condition racket-expression)
                       (side-condition/hidden racket-expression)
                       (where pat @#,tttterm)
-                      (where/hidden pat @#,tttterm)])]{
+                      (where/hidden pat @#,tttterm)
+                      (judgment-holds 
+                       (judgment-form-id pat/term ...))])]{
 
 The @racket[define-metafunction] form builds a function on
 sexpressions according to the pattern and right-hand-side
diff --git a/collects/redex/reduction-semantics.rkt b/collects/redex/reduction-semantics.rkt
index c04fd42205..a95d0b7b74 100644
--- a/collects/redex/reduction-semantics.rkt
+++ b/collects/redex/reduction-semantics.rkt
@@ -40,6 +40,7 @@
          term-match/single
          redex-let
          redex-let*
+         define-term
          match? match-bindings
          make-bind bind? bind-name bind-exp
          
diff --git a/collects/redex/tests/bitmap-test.rkt b/collects/redex/tests/bitmap-test.rkt
index 448de5d24f..7c5639abd1 100644
--- a/collects/redex/tests/bitmap-test.rkt
+++ b/collects/redex/tests/bitmap-test.rkt
@@ -98,6 +98,18 @@
 (test (render-metafunction S)
       "metafunction.png")
 
+(let ()
+  (define-metafunction lang
+    [(f (e_1 e_2))
+     (e_3 e_4)
+     (judgment-holds (J e_1 e_3))
+     (judgment-holds (J e_2 e_4))])
+  (define-judgment-form lang
+    #:mode (J I O)
+    [(J e e)])
+  (test (render-metafunction f)
+        "metafunction-judgment-holds.png"))
+
 (define-metafunction lang
   [(T x y)
    1
@@ -367,4 +379,4 @@
         "stlc.png"))  
 
 (printf "bitmap-test.rkt: ")
-(done)
\ No newline at end of file
+(done)
diff --git a/collects/redex/tests/bmps-macosx/metafunction-judgment-holds.png b/collects/redex/tests/bmps-macosx/metafunction-judgment-holds.png
new file mode 100644
index 0000000000..df49babea9
Binary files /dev/null and b/collects/redex/tests/bmps-macosx/metafunction-judgment-holds.png differ
diff --git a/collects/redex/tests/check-syntax-test.rkt b/collects/redex/tests/check-syntax-test.rkt
index 357fd0c3a3..b173b35173 100644
--- a/collects/redex/tests/check-syntax-test.rkt
+++ b/collects/redex/tests/check-syntax-test.rkt
@@ -153,4 +153,25 @@
   (test (send annotations collected-rename-class contract-name)
         (expected-rename-class metafunction-binding)))
 
+;; define-term
+(let ([annotations (new collector%)])
+  (define-values (add-syntax done)
+    (make-traversal module-namespace #f))
+  
+  (define def-name (identifier x))
+  (define use-name (identifier x))
+  
+  (parameterize ([current-annotations annotations]
+                 [current-namespace module-namespace])
+    (add-syntax
+     (expand #`(let ()
+                 (define-term #,def-name a)
+                 (term (#,use-name b)))))
+    (done))
+  
+  (test (send annotations collected-rename-class def-name)
+        (expected-rename-class (list def-name use-name)))
+  (test (send annotations collected-rename-class def-name)
+        (expected-rename-class (list def-name use-name))))
+
 (print-tests-passed 'check-syntax-test.rkt)
\ No newline at end of file
diff --git a/collects/redex/tests/defined-checks-test.rkt b/collects/redex/tests/defined-checks-test.rkt
new file mode 100644
index 0000000000..c2d4b84e0f
--- /dev/null
+++ b/collects/redex/tests/defined-checks-test.rkt
@@ -0,0 +1,24 @@
+#lang racket
+
+(require "test-util.rkt"
+         "../private/error.rkt"
+         "../private/defined-checks.rkt")
+
+(reset-count)
+
+(define expected-message "reference to thing x before its definition")
+
+(test (with-handlers ([exn:fail:redex? exn-message])
+        (check-defined-lexical x 'x "thing")
+        (define x 4)
+        "")
+      expected-message)
+
+(test (with-handlers ([exn:fail:redex? exn-message])
+        (check-defined-module (λ () x) 'x "thing")
+        "")
+      expected-message)
+
+(define x 4)
+
+(print-tests-passed 'defined-checks-test.rkt)
\ No newline at end of file
diff --git a/collects/redex/tests/run-err-tests/judgment-form-undefined.rktd b/collects/redex/tests/run-err-tests/judgment-form-undefined.rktd
index 04c37d2b03..0a4f2e6e66 100644
--- a/collects/redex/tests/run-err-tests/judgment-form-undefined.rktd
+++ b/collects/redex/tests/run-err-tests/judgment-form-undefined.rktd
@@ -1,4 +1,4 @@
-("judgment form q applied before its definition"
+("reference to judgment form q before its definition"
  ([use q]) ([def q])
  (let ()
    (judgment-holds (use 1))
diff --git a/collects/redex/tests/run-err-tests/metafunction-undefined.rktd b/collects/redex/tests/run-err-tests/metafunction-undefined.rktd
new file mode 100644
index 0000000000..a01c78b7f6
--- /dev/null
+++ b/collects/redex/tests/run-err-tests/metafunction-undefined.rktd
@@ -0,0 +1,8 @@
+("reference to metafunction q before its definition"
+ ([use q]) ([def q])
+ (let ()
+   (term (use))
+   (define-language L)
+   (define-metafunction L
+     [(def) ()])
+   #f))
\ No newline at end of file
diff --git a/collects/redex/tests/run-err-tests/term.rktd b/collects/redex/tests/run-err-tests/term.rktd
index 0a6e36dd15..33d502408e 100644
--- a/collects/redex/tests/run-err-tests/term.rktd
+++ b/collects/redex/tests/run-err-tests/term.rktd
@@ -39,4 +39,11 @@
 
 (#rx"term .* does not match pattern"
  ([rhs 'a]) ([ellipsis ...])
- (term-let ([(x ellipsis) rhs]) 3))
\ No newline at end of file
+ (term-let ([(x ellipsis) rhs]) 3))
+
+("reference to term x before its definition"
+ ([use x]) ([def x])
+ (let ()
+   (define t (term (use y)))
+   (define-term def z)
+   t))
\ No newline at end of file
diff --git a/collects/redex/tests/run-tests.rkt b/collects/redex/tests/run-tests.rkt
index bca1653099..d70ccd71cf 100644
--- a/collects/redex/tests/run-tests.rkt
+++ b/collects/redex/tests/run-tests.rkt
@@ -26,6 +26,7 @@
      "pict-test.rkt"
      "hole-test.rkt"
      "stepper-test.rkt"
+     "defined-checks-test.rkt"
      "check-syntax-test.rkt"
      "test-docs-complete.rkt")
    (if test-bitmaps? '("bitmap-test.rkt") '())
diff --git a/collects/redex/tests/syn-err-tests/judgment-form-definition.rktd b/collects/redex/tests/syn-err-tests/judgment-form-definition.rktd
index 1cb8d0d51a..284564f050 100644
--- a/collects/redex/tests/syn-err-tests/judgment-form-definition.rktd
+++ b/collects/redex/tests/syn-err-tests/judgment-form-definition.rktd
@@ -182,4 +182,28 @@
      #:mode (name I)
      [(name binder)
       premise ellipsis])
+   (void)))
+
+(#rx"unbound pattern variable"
+ ([x f_7])
+ (let ()
+   (define-language L
+     (f any))
+   (define-judgment-form L
+     #:mode (J1 O)
+     [(J1 x)])
+   (void)))
+
+(#rx"unbound pattern variable"
+ ([use f_2]) ([outer-def f_2] [inner-def f_2])
+ (let ()
+   (define-language L
+     (f any))
+   (define-metafunction L
+     [(outer-def) ()])
+   (define-judgment-form L
+     #:mode (K I I O)
+     [(K a any_1 x)
+      (K b (use) (name inner-def any))]
+     [(K b any K-b-out)])
    (void)))
\ No newline at end of file
diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt
index e2853ea061..c58a04472f 100644
--- a/collects/redex/tests/tl-test.rkt
+++ b/collects/redex/tests/tl-test.rkt
@@ -977,6 +977,33 @@
                  x)
           '(2 1)))
   
+  (let ()
+    (define-language L
+      (n z (s n)))
+    
+    (define-metafunction L
+      [(f n)
+       n_1
+       (judgment-holds (p n n_1))])
+    
+    (define-judgment-form L
+      #:mode (p I O)
+      #:contract (p n n)
+      [(p z z)]
+      [(p (s n) n)]
+      [(p (s n) z)])
+    
+    (test (term (f (s z)))
+          (term z))
+    (test (with-handlers ([exn:fail:redex? exn-message])
+            (term (f (s (s z))))
+            "")
+          #rx"different ways and returned different results"))
+  
+  (parameterize ([current-namespace (make-base-namespace)])
+    (eval '(require redex/reduction-semantics))
+    (exec-runtime-error-tests "run-err-tests/judgment-form-undefined.rktd"))
+  
   ;; errors for not-yet-defined metafunctions
   (test (parameterize ([current-namespace (make-empty-namespace)])
           (namespace-attach-module (namespace-anchor->namespace this-namespace) 'redex/reduction-semantics)
@@ -989,14 +1016,14 @@
           (with-handlers ([exn:fail:redex? exn-message])
             (eval '(require 'm))
             #f))
-        "metafunction q applied before its definition")
+        "reference to metafunction q before its definition")
   (test (with-handlers ([exn:fail:redex? exn-message])
           (let ()
             (term (q))
             (define-language L)
             (define-metafunction L [(q) ()])
             #f))
-        "metafunction q applied before its definition")
+        "reference to metafunction q before its definition")
   
   (exec-syntax-error-tests "syn-err-tests/metafunction-definition.rktd")
 ;                                                                                                 
@@ -1818,6 +1845,19 @@
                    (judgment-holds (R a any))))
              'a)
             '(a b)))
+    
+    ; a call to a metafunction that looks like a pattern variable
+    (let ()
+      (define result 'result)
+      (define-language L
+        (f any))
+      (define-judgment-form L
+        #:mode (J O)
+        [(J (f_2))])
+      (define-metafunction L
+        [(f_2) ,result])
+      (test (judgment-holds (J any) any)
+            (list result)))
   
     ;                                                                 
     ;                                                                 
@@ -2127,9 +2167,32 @@
       (exec-runtime-error-tests "run-err-tests/judgment-form-undefined.rktd")
       (exec-runtime-error-tests "run-err-tests/judgment-form-ellipses.rktd"))
     
-    (parameterize ([current-namespace (make-base-namespace)])
-      (eval '(require redex/reduction-semantics))
-      (exec-runtime-error-tests "run-err-tests/judgment-form-undefined.rktd"))
+  
+;                                                                               
+;                                                                               
+;                                                                               
+;       ;            ;;    ;                                                    
+;       ;           ;      ;                          ;                         
+;       ;           ;                                 ;                         
+;    ;;;;   ;;;    ;;;     ;    ;;;;    ;;;          ;;;     ;;;   ; ;;   ;;;;; 
+;   ;   ;  ;   ;    ;      ;    ;   ;  ;   ;  ;;;;;   ;     ;   ;  ;;  ;  ; ; ; 
+;   ;   ;  ;;;;;    ;      ;    ;   ;  ;;;;;          ;     ;;;;;  ;   ;  ; ; ; 
+;   ;   ;  ;        ;      ;    ;   ;  ;              ;     ;      ;      ; ; ; 
+;   ;   ;  ;   ;    ;      ;    ;   ;  ;   ;          ;     ;   ;  ;      ; ; ; 
+;    ;;;;   ;;;     ;      ;    ;   ;   ;;;            ;;    ;;;   ;      ; ; ; 
+;                                                                               
+;                                                                               
+;                                                                               
+  
+  (test (let ()
+          (define-term x 1)
+          (term (x x)))
+        (term (1 1)))
+  (test (let ()
+          (define-term x 1)
+          (let ([x 'whatever])
+            (term (x x))))
+        (term (x x)))
     
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;
diff --git a/collects/scribble/doclang.rkt b/collects/scribble/doclang.rkt
index 3d6ce9b7cd..1acbea935f 100644
--- a/collects/scribble/doclang.rkt
+++ b/collects/scribble/doclang.rkt
@@ -54,7 +54,7 @@
                                               provide
                                               define-values
                                               define-syntaxes
-                                              define-values-for-syntax
+                                              begin-for-syntax
                                               #%require
                                               #%provide))))
                  #`(begin #,expanded (doc-begin m-id post-process exprs . body))]
diff --git a/collects/scribble/private/lp.rkt b/collects/scribble/private/lp.rkt
index ac8a10f61d..a565a293bd 100644
--- a/collects/scribble/private/lp.rkt
+++ b/collects/scribble/private/lp.rkt
@@ -50,7 +50,6 @@
                      [(rest ...) (if n
                                      #`((subscript #,(format "~a" n)))
                                      #`())])
-         
          #`(begin
              (require (for-label for-label-mod ... ...))
              #,@(if n
diff --git a/collects/scribble/private/manual-style.rkt b/collects/scribble/private/manual-style.rkt
index 376de95330..39b968606e 100644
--- a/collects/scribble/private/manual-style.rkt
+++ b/collects/scribble/private/manual-style.rkt
@@ -30,7 +30,7 @@
   (provide/contract [id styling-f/c] ...))
 (provide-styling racketmodfont racketoutput
                  racketerror racketfont racketvalfont racketresultfont racketidfont racketvarfont
-                 racketparenfont racketkeywordfont racketmetafont
+                 racketcommentfont racketparenfont racketkeywordfont racketmetafont
                  onscreen defterm filepath exec envvar Flag DFlag PFlag DPFlag math
                  procedure
                  indexed-file indexed-envvar idefterm pidefterm)
@@ -101,6 +101,8 @@
   (make-element paren-color (decode-content str)))
 (define (racketmetafont . str)
   (make-element meta-color (decode-content str)))
+(define (racketcommentfont . str)
+  (make-element comment-color (decode-content str)))
 (define (racketmodfont . str)
   (make-element module-color (decode-content str)))
 (define (racketkeywordfont . str)
diff --git a/collects/scribble/private/manual-vars.rkt b/collects/scribble/private/manual-vars.rkt
index 1d4bea712f..e37357ba91 100644
--- a/collects/scribble/private/manual-vars.rkt
+++ b/collects/scribble/private/manual-vars.rkt
@@ -73,7 +73,9 @@
                       (let loop ([form (case (syntax-e kind)
                                          [(form) (if (identifier? s-exp)
                                                      null
-                                                     (cdr (syntax-e s-exp)))]
+                                                     (if (pair? (syntax-e s-exp))
+                                                         (cdr (syntax-e s-exp))
+                                                         null))]
                                          [(form/none) s-exp]
                                          [(form/maybe)
                                           (syntax-case s-exp ()
diff --git a/collects/scribble/text/syntax-utils.rkt b/collects/scribble/text/syntax-utils.rkt
index 794ea84b0b..16c249b3d1 100644
--- a/collects/scribble/text/syntax-utils.rkt
+++ b/collects/scribble/text/syntax-utils.rkt
@@ -7,7 +7,7 @@
 
 (begin-for-syntax
   (define definition-ids ; ids that don't require forcing
-    (syntax->list #'(define-values define-syntaxes define-values-for-syntax
+    (syntax->list #'(define-values define-syntaxes begin-for-syntax
                      require provide #%require #%provide)))
   (define stoplist (append definition-ids (kernel-form-identifier-list)))
   (define (definition-id? id)
diff --git a/collects/scribble/tools/drracket-buttons.rkt b/collects/scribble/tools/drracket-buttons.rkt
index 95fbdb558f..9a91d24490 100644
--- a/collects/scribble/tools/drracket-buttons.rkt
+++ b/collects/scribble/tools/drracket-buttons.rkt
@@ -25,6 +25,7 @@
    bmp
    (λ (drs-frame)
      (define fn (send (send drs-frame get-definitions-text) get-filename))
+     (define html? (equal? suffix #".html"))
      (cond
        [fn
         (parameterize ([drracket:rep:after-expression
@@ -32,15 +33,21 @@
                           (printf "scribble: loading xref\n")
                           (define xref ((dynamic-require 'setup/xref 'load-collections-xref)))
                           (printf "scribble: rendering\n")
-                          ((dynamic-require 'scribble/render 'render) 
-                           (list (eval 'doc))
-                           (list fn)
-                           #:xrefs (list xref))
+                          (parameterize ([current-input-port (open-input-string "")])
+                            ((dynamic-require 'scribble/render 'render) 
+                             (list (eval 'doc))
+                             (list fn)
+                             #:render-mixin (dynamic-require (if html? 
+                                                                 'scribble/html-render
+                                                                 'scribble/pdf-render)
+                                                             'render-mixin)
+                             #:xrefs (list xref)))
                           (cond
-                            [(equal? suffix #".html")
+                            [html?
                              (send-url/file (path-replace-suffix fn suffix))]
                             [else
-                             (system (format "open ~s" (path->string (path-replace-suffix fn suffix))))]))]) 
+                             (parameterize ([current-input-port (open-input-string "")])
+                               (system (format "open \"~a\"" (path->string (path-replace-suffix fn suffix)))))]))]) 
           (send drs-frame execute-callback))]
        [else
         (message-box "Scribble" "Cannot render buffer without filename")]))))
diff --git a/collects/scribblings/drracket/interface-essentials.scrbl b/collects/scribblings/drracket/interface-essentials.scrbl
index 75a9bc4921..ed628c7728 100644
--- a/collects/scribblings/drracket/interface-essentials.scrbl
+++ b/collects/scribblings/drracket/interface-essentials.scrbl
@@ -142,6 +142,16 @@ annotations:
 
 ]
 
+Check Syntax also runs interactively and the bottom, rightmost corner of the DrRacket window
+shows its status. A blue or green dot indicates that Check Syntax is running in the background
+(the green dot indicates that the check syntax information has been computed and is
+now being put into the DrRacket window proper). A red dot means that something has gone wrong;
+move your mouse over the dot to find out what is wrong. Mis-matched parentheses indicates
+that the buffer's parens are also mismatched; mouse over the parens for details.
+
+Also, right-clicking in that area yields a menu that lets you disable
+(or re-eneable) online Check Syntax.
+
 The @as-index{@onscreen{Run} button} evaluates the program in the
 @tech{definitions window} and resets the @tech{interactions window}.
 
diff --git a/collects/scribblings/foreign/cpointer.scrbl b/collects/scribblings/foreign/cpointer.scrbl
index 4faf57f91a..5c40a00f4d 100644
--- a/collects/scribblings/foreign/cpointer.scrbl
+++ b/collects/scribblings/foreign/cpointer.scrbl
@@ -22,9 +22,10 @@ to Racket, and accept only such tagged pointers when going to C.  An
 optional @racket[ptr-type] can be given to be used as the base pointer
 type, instead of @racket[_pointer].
 
-By convention, tags should be symbols named after the
-type they point to.  For example, the cpointer @racket[_car] should
-be created using @racket['car] as the key.
+By convention, tags are symbols named after the
+type they point to.  For example, the cpointer @racket[_car] would
+be created using @racket['car] as the key. However, any symbol can be
+used as the tag.
 Pointer tags are checked with @racket[cpointer-has-tag?] and changed
 with @racket[cpointer-push-tag!] which means that other tags are
 preserved.  Specifically, if a base @racket[ptr-type] is given and is
@@ -46,7 +47,7 @@ are not tagged.}
                                  scheme-to-c-expr c-to-scheme-expr)]]{
 
 A macro version of @racket[_cpointer] and @racket[_cpointer/null],
-using the defined name for a tag string, and defining a predicate
+using the defined name for a tag symbol, and defining a predicate
 too. The @racket[_id] must start with @litchar{_}.
 
 The optional expressions produce optional arguments to @racket[_cpointer].
@@ -56,7 +57,7 @@ In addition to defining @racket[_id] to a type generated by
 type produced by @racket[_cpointer/null] type. Finally,
 @racketvarfont{id}@racketidfont{?}  is defined as a predicate, and
 @racketvarfont{id}@racketidfont{-tag} is defined as an accessor to
-obtain a tag. The tag is the string form of @racketvarfont{id}.}
+obtain a tag. The tag is the symbol form of @racketvarfont{id}.}
 
 @defproc*[([(cpointer-has-tag? [cptr any/c] [tag any/c]) boolean?]
            [(cpointer-push-tag! [cptr any/c] [tag any/c]) void])]{
diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl
index 91f8b48960..1a343e893f 100644
--- a/collects/scribblings/foreign/types.scrbl
+++ b/collects/scribblings/foreign/types.scrbl
@@ -857,8 +857,10 @@ The resulting bindings are as follows:
 
  @item{@racketvarfont{id}@racketidfont{?}: a predicate for the new type.}
 
- @item{@racketvarfont{id}@racketidfont{-tag}: the tag string object that is
-  used with instances.}
+ @item{@racketvarfont{id}@racketidfont{-tag}: the tag object that is
+  used with instances.  The tag object may be the symbol form of 
+  @racketvarfont{id} or a list of symbols containing the @racketvarfont{id}
+  symbol and other symbols, such as the @racketvarfont{super-id} symbol.}
 
  @item{@racketidfont{make-}@racketvarfont{id} : a constructor, which expects
   an argument for each type.}
@@ -876,10 +878,14 @@ The resulting bindings are as follows:
   currently, this information is correct only when no @racket[super-id]
   is specified.}
 
+@item{@racketvarfont{id}->list : a function that converts a struct into
+ a list of values.}
+
 ]
 
 Objects of the new type are actually C pointers, with a type tag that
-is a list that contains the string form of @racketvarfont{id}.  Since
+is the symbol form of @racketvarfont{id} or a list that contains the 
+symbol form of @racketvarfont{id}.  Since
 structs are implemented as pointers, they can be used for a
 @racket[_pointer] input to a foreign function: their address will be
 used.  To make this a little safer, the corresponding cpointer type is
diff --git a/collects/scribblings/framework/frame.scrbl b/collects/scribblings/framework/frame.scrbl
index 85c9b1b14b..1ffda924d5 100644
--- a/collects/scribblings/framework/frame.scrbl
+++ b/collects/scribblings/framework/frame.scrbl
@@ -28,7 +28,9 @@
 
     Return @racket[menu-bar%].
   }
-  @defmethod*[(((make-root-area-container (class (implementation?/c area-container<%>)) (parent (is-a?/c area-container<%>))) (is-a?/c area-container<%>)))]{
+  @defmethod*[(((make-root-area-container (class (implementation?/c area-container<%>))
+                                          (parent (is-a?/c area-container<%>)))
+                (is-a?/c area-container<%>)))]{
     Override this method to insert a panel in between the panel used by
     the clients of this frame and the frame itself. For example, to insert
     a status line panel override this method with something like this:
@@ -160,6 +162,35 @@
     using the @method[frame:basic<%> make-root-area-container] method).
   }
 }
+
+@definterface[frame:focus-table<%> (top-level-window<%>)]{}
+
+@defmixin[frame:focus-table-mixin (frame%) (frame:focus-table<%>)]{
+
+  Instances of classes returned from this mixin track how frontmost they are
+  based on calls made to methods at the Racket level, instead of using
+  the calls made by the operating system as it tracks the focus.
+  
+  See also @racket[frame:lookup-focus-table], @racket[test:use-focus-table]
+  and @racket[test:get-active-top-level-window].
+                                                         
+  @defmethod[#:mode override (show [on? boolean?]) void?]{
+    When @racket[on?] is @racket[#t], adds this frame to the 
+    front of the list of frames stored with the frame's eventspace. When 
+    @racket[on?] is @racket[#f], this method removes this frame
+    from the list.
+
+    See also @racket[frame:lookup-focus-table], @racket[test:use-focus-table]
+    and @racket[test:get-active-top-level-window].
+  }
+  @defmethod[#:mode augment (on-close) void?]{
+    Removes this frame from the list of frames stored with the frame's eventspace.
+    
+    See also @racket[frame:lookup-focus-table], @racket[test:use-focus-table]
+    and @racket[test:get-active-top-level-window].
+  }
+}
+                                                     
 @definterface[frame:size-pref<%> (frame:basic<%>)]{
 
 }
@@ -264,7 +295,9 @@
 }
 @defmixin[frame:status-line-mixin (frame:basic<%>) (frame:status-line<%>)]{
 
-  @defmethod*[#:mode override (((make-root-area-container (class (subclass?/c panel%)) (parent (is-a?/c panel%))) (is-a?/c panel%)))]{
+  @defmethod*[#:mode override (((make-root-area-container (class (subclass?/c panel%)) 
+                                                          (parent (is-a?/c panel%)))
+                                (is-a?/c panel%)))]{
 
     Adds a panel at the bottom of the frame to hold the status
     lines.
@@ -344,7 +377,9 @@
   The result of this mixin uses the same initialization arguments as the
   mixin's argument.
 
-  @defmethod*[#:mode override (((make-root-area-container (class (subclass?/c area-container<%>)) (parent (is-a?/c area-container<%>))) (is-a?/c area-container<%>)))]{
+  @defmethod*[#:mode override (((make-root-area-container (class (subclass?/c area-container<%>))
+                                                          (parent (is-a?/c area-container<%>)))
+                                (is-a?/c area-container<%>)))]{
 
     Builds an extra panel for displaying various information.
   }
@@ -526,7 +561,16 @@
                    (height (or/c (integer-in 0 10000) false/c) #f)
                    (x (or/c (integer-in -10000 10000) false/c) #f)
                    (y (or/c (integer-in -10000 10000) false/c) #f)
-                   (style (listof (or/c 'no-resize-border 'no-caption 'no-system-menu 'hide-menu-bar 'mdi-parent 'mdi-child 'toolbar-button 'float 'metal)) null)
+                   (style (listof (or/c 'no-resize-border
+                                        'no-caption
+                                        'no-system-menu
+                                        'hide-menu-bar
+                                        'mdi-parent
+                                        'mdi-child
+                                        'toolbar-button
+                                        'float
+                                        'metal))
+                          null)
                    (enabled any/c #t)
                    (border (integer-in 0 1000) 0)
                    (spacing (integer-in 0 1000) 0)
@@ -590,7 +634,9 @@
     returns @racket[#t].
   }
 
-  @defmethod*[#:mode override (((file-menu:save-as-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
+  @defmethod*[#:mode override (((file-menu:save-as-callback (item (is-a?/c menu-item%))
+                                                            (evt (is-a?/c control-event%)))
+                                void?))]{
     Prompts the user for a file name and uses that filename to save the buffer.
     Calls @method[frame:editor<%> save-as] with no arguments.
   }
@@ -599,7 +645,9 @@
     returns @racket[#t].
   }
 
-  @defmethod*[#:mode override (((file-menu:print-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
+  @defmethod*[#:mode override (((file-menu:print-callback (item (is-a?/c menu-item%)) 
+                                                          (evt (is-a?/c control-event%)))
+                                void?))]{
     Calls the @method[editor<%> print] method of @racket[editor<%>] with the
     default arguments, except that the @racket[output-mode] argument is the
     result of calling @racket[preferences:get] with
@@ -619,7 +667,9 @@
     text.
   }
 
-  @defmethod*[#:mode override (((help-menu:about-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
+  @defmethod*[#:mode override (((help-menu:about-callback (item (is-a?/c menu-item%)) 
+                                                          (evt (is-a?/c control-event%)))
+                                void?))]{
     Calls @racket[message-box] with a message welcoming the user to the
     application named by @racket[application:current-app-name]
   }
@@ -663,7 +713,9 @@
     @racket['framework:open-here?] is set.
   }
 
-  @defmethod*[#:mode override (((file-menu:new-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
+  @defmethod*[#:mode override (((file-menu:new-callback (item (is-a?/c menu-item%))
+                                                        (evt (is-a?/c control-event%))) 
+                                void?))]{
     When the preference @racket['framework:open-here?]  preference is set, this
     method prompts the user, asking if they would like to create a new frame,
     or just clear out this one. If they clear it out and the file hasn't been
@@ -766,7 +818,9 @@
   Adds support for a 20,000-feet view via @racket[text:delegate<%>] and
   @racket[text:delegate-mixin].
 
-  @defmethod*[#:mode override (((make-root-area-container (class (subclass?/c panel%)) (parent (is-a?/c panel%))) (is-a?/c panel%)))]{
+  @defmethod*[#:mode override (((make-root-area-container (class (subclass?/c panel%))
+                                                          (parent (is-a?/c panel%)))
+                                (is-a?/c panel%)))]{
     Adds a panel outside to hold the delegate @racket[editor-canvas%] and
     @racket[text%].
   }
@@ -867,7 +921,10 @@
     returns @racket[#t].
   }
 
-  @defmethod*[#:mode override (((edit-menu:find-again-backwards-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
+  @defmethod*[#:mode override (((edit-menu:find-again-backwards-callback
+                                 (item (is-a?/c menu-item%))
+                                 (evt (is-a?/c control-event%)))
+                                void?))]{
     Calls @method[frame:searchable unhide-search] and then
     @method[frame:searchable<%> search].
   }
diff --git a/collects/scribblings/framework/main-extracts.rkt b/collects/scribblings/framework/main-extracts.rkt
index 443097475f..6d7e7c29f2 100644
--- a/collects/scribblings/framework/main-extracts.rkt
+++ b/collects/scribblings/framework/main-extracts.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 (require scribble/extract)
 
 (provide-extracted (lib "framework/main.rkt"))
diff --git a/collects/scribblings/framework/standard-menus.scrbl b/collects/scribblings/framework/standard-menus.scrbl
index 112eff7648..247a4cdb26 100644
--- a/collects/scribblings/framework/standard-menus.scrbl
+++ b/collects/scribblings/framework/standard-menus.scrbl
@@ -1,14 +1,14 @@
-;; THIS FILE IS GENERATED. DO NOT EDIT.
-
-@definterface[frame:standard-menus<%> (frame:basic<%>)]{
-
-@(defmethod (on-close) void? "Removes the preferences callbacks for the menu items")
+;; THIS FILE IS GENERATED. DO NOT EDIT.
+
+@definterface[frame:standard-menus<%> (frame:basic<%>)]{
+
+
@(defmethod (on-close) void? "Removes the preferences callbacks for the menu items")
 
 @(defmethod (get-menu%) (is-a?/c menu:can-restore-underscore-menu%) "The result of this method is used as the class" "\n" "    " "for creating the result of these methods:" "\n" "    " (method frame:standard-menus get-file-menu) "," "\n" "    " (method frame:standard-menus get-edit-menu) ", and" "\n" "    " (method frame:standard-menus get-help-menu) ".")
 
 @(defmethod (get-menu-item%) (is-a?/c menu:can-restore-menu-item%) "The result of this method is used as the class for creating" "\n" "the menu items in this frame." "\n" "\n" "Returns " (racket menu:can-restore-menu-item) " by default.")
 
-@(defmethod (get-checkable-menu-item%) (is-a?/c menu:can-restore-checkable-menu-item%) "The result of this method is used as the class for creating" "\n" "checkable menu items in this class." "\n" "\n" "Returns " (racket menu:can-restore-checkable-menu-item) " by default.")
+@(defmethod (get-checkable-menu-item%) (is-a?/c menu:can-restore-checkable-menu-item%) "The result of this method is used as the class for creating" "\n" "checkable menu items in this class." "\n" "\n" "returns " (racket menu:can-restore-checkable-menu-item) " by default.")
 
 @(defmethod (get-file-menu) (is-a?/c menu%) "Returns the file menu." "\n" "See also " (method frame:standard-menus<%> get-menu%) ".")
 
@@ -16,338 +16,338 @@
 
 @(defmethod (get-help-menu) (is-a?/c menu%) "Returns the help menu." "\n" "See also " (method frame:standard-menus<%> get-menu%) ".")
 
-@(defmethod (file-menu:get-new-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-new?) ").")
+@(defmethod (file-menu:get-new-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-new?) ").")
 
 @(defmethod (file-menu:create-new?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (file-menu:new-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (handler:edit-file #f) #t)) " ")
+@(defmethod (file-menu:new-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (handler:edit-file #f) #t)) " ")
 
-@(defmethod (file-menu:new-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:new-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:new-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant new-menu-item)) ".")
+@(defmethod (file-menu:new-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant new-menu-item)) ".")
 
-@(defmethod (file-menu:new-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant new-info)) ".")
+@(defmethod (file-menu:new-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant new-info)) ".")
 
-@(defmethod (file-menu:between-new-and-open (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "new") " and the " (tt "open") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (file-menu:between-new-and-open (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "new") " and the " (tt "open") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (file-menu:get-open-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-open?) ").")
+@(defmethod (file-menu:get-open-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-open?) ").")
 
 @(defmethod (file-menu:create-open?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (file-menu:open-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (handler:open-file) #t)) " ")
+@(defmethod (file-menu:open-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (handler:open-file) #t)) " ")
 
-@(defmethod (file-menu:open-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:open-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:open-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant open-menu-item)) ".")
+@(defmethod (file-menu:open-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant open-menu-item)) ".")
 
-@(defmethod (file-menu:open-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant open-info)) ".")
+@(defmethod (file-menu:open-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant open-info)) ".")
 
-@(defmethod (file-menu:get-open-recent-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-open-recent?) ").")
+@(defmethod (file-menu:get-open-recent-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-open-recent?) ").")
 
 @(defmethod (file-menu:create-open-recent?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (file-menu:open-recent-callback (x (is-a?/c menu-item<%>)) (y (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (file-menu:open-recent-callback (x (is-a?/c menu-item%)) (y (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (file-menu:open-recent-on-demand (menu (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (handler:install-recent-items menu)))
+@(defmethod (file-menu:open-recent-on-demand (menu (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (handler:install-recent-items menu)))
 
-@(defmethod (file-menu:open-recent-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant open-recent-menu-item)) ".")
+@(defmethod (file-menu:open-recent-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant open-recent-menu-item)) ".")
 
-@(defmethod (file-menu:open-recent-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant open-recent-info)) ".")
+@(defmethod (file-menu:open-recent-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant open-recent-info)) ".")
 
-@(defmethod (file-menu:between-open-and-revert (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "open") " and the " (tt "revert") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (file-menu:between-open-and-revert (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "open") " and the " (tt "revert") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (file-menu:get-revert-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-revert?) ").")
+@(defmethod (file-menu:get-revert-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-revert?) ").")
 
 @(defmethod (file-menu:create-revert?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (file-menu:revert-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (file-menu:revert-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (file-menu:revert-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:revert-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:revert-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant revert-menu-item)) ".")
+@(defmethod (file-menu:revert-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant revert-menu-item)) ".")
 
-@(defmethod (file-menu:revert-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant revert-info)) ".")
+@(defmethod (file-menu:revert-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant revert-info)) ".")
 
-@(defmethod (file-menu:between-revert-and-save (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "revert") " and the " (tt "save") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (file-menu:between-revert-and-save (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "revert") " and the " (tt "save") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (file-menu:get-save-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-save?) ").")
+@(defmethod (file-menu:get-save-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-save?) ").")
 
 @(defmethod (file-menu:create-save?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (file-menu:save-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (file-menu:save-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (file-menu:save-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:save-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:save-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant save-menu-item)) ".")
+@(defmethod (file-menu:save-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant save-menu-item)) ".")
 
-@(defmethod (file-menu:save-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant save-info)) ".")
+@(defmethod (file-menu:save-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant save-info)) ".")
 
-@(defmethod (file-menu:get-save-as-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-save-as?) ").")
+@(defmethod (file-menu:get-save-as-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-save-as?) ").")
 
 @(defmethod (file-menu:create-save-as?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (file-menu:save-as-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (file-menu:save-as-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (file-menu:save-as-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:save-as-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:save-as-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant save-as-menu-item)) ".")
+@(defmethod (file-menu:save-as-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant save-as-menu-item)) ".")
 
-@(defmethod (file-menu:save-as-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant save-as-info)) ".")
+@(defmethod (file-menu:save-as-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant save-as-info)) ".")
 
-@(defmethod (file-menu:between-save-as-and-print (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "save-as") " and the " (tt "print") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (file-menu:between-save-as-and-print (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "save-as") " and the " (tt "print") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (file-menu:get-print-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-print?) ").")
+@(defmethod (file-menu:get-print-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-print?) ").")
 
 @(defmethod (file-menu:create-print?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (file-menu:print-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (file-menu:print-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (file-menu:print-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:print-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:print-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant print-menu-item)) ".")
+@(defmethod (file-menu:print-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant print-menu-item)) ".")
 
-@(defmethod (file-menu:print-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant print-info)) ".")
+@(defmethod (file-menu:print-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant print-info)) ".")
 
-@(defmethod (file-menu:between-print-and-close (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "print") " and the " (tt "close") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (file-menu:between-print-and-close (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "print") " and the " (tt "close") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (file-menu:get-close-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-close?) ").")
+@(defmethod (file-menu:get-close-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-close?) ").")
 
 @(defmethod (file-menu:create-close?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (file-menu:close-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (when (can-close?) (on-close) (show #f)) #t)) " ")
+@(defmethod (file-menu:close-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (when (can-close?) (on-close) (show #f)) #t)) " ")
 
-@(defmethod (file-menu:close-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:close-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:close-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant close-menu-item)) ".")
+@(defmethod (file-menu:close-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (if (eq? (system-type) (quote unix)) (string-constant close-menu-item) (string-constant close-window-menu-item))) ".")
 
-@(defmethod (file-menu:close-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant close-info)) ".")
+@(defmethod (file-menu:close-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant close-info)) ".")
 
-@(defmethod (file-menu:between-close-and-quit (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "close") " and the " (tt "quit") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (file-menu:between-close-and-quit (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "close") " and the " (tt "quit") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (file-menu:get-quit-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-quit?) ").")
+@(defmethod (file-menu:get-quit-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> file-menu:create-quit?) ").")
 
 @(defmethod (file-menu:create-quit?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket (not (eq? (system-type) (quote macosx)))) ".")
 
-@(defmethod (file-menu:quit-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (when (exit:user-oks-exit) (exit:exit))) " ")
+@(defmethod (file-menu:quit-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (when (exit:user-oks-exit) (exit:exit))) " ")
 
-@(defmethod (file-menu:quit-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (file-menu:quit-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (file-menu:quit-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (if (eq? (system-type) (quote windows)) (string-constant quit-menu-item-windows) (string-constant quit-menu-item-others))) ".")
+@(defmethod (file-menu:quit-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (if (eq? (system-type) (quote windows)) (string-constant quit-menu-item-windows) (string-constant quit-menu-item-others))) ".")
 
-@(defmethod (file-menu:quit-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant quit-info)) ".")
+@(defmethod (file-menu:quit-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant quit-info)) ".")
 
-@(defmethod (file-menu:after-quit (menu (is-a?/c menu-item<%>))) void? "This method is called " "after" " the addition of the" "\n" (tt "quit") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
+@(defmethod (file-menu:after-quit (menu (is-a?/c menu-item%))) void? "This method is called " "after" " the addition of the" "\n" (tt "quit") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
 
-@(defmethod (edit-menu:get-undo-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-undo?) ").")
+@(defmethod (edit-menu:get-undo-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-undo?) ").")
 
 @(defmethod (edit-menu:create-undo?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:undo-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote undo)))) #t)) " ")
+@(defmethod (edit-menu:undo-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote undo)))) #t)) " ")
 
-@(defmethod (edit-menu:undo-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote undo))))) (send item enable enable?))))
+@(defmethod (edit-menu:undo-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote undo))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:undo-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant undo-menu-item)) ".")
+@(defmethod (edit-menu:undo-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant undo-menu-item)) ".")
 
-@(defmethod (edit-menu:undo-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant undo-info)) ".")
+@(defmethod (edit-menu:undo-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant undo-info)) ".")
 
-@(defmethod (edit-menu:get-redo-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-redo?) ").")
+@(defmethod (edit-menu:get-redo-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-redo?) ").")
 
 @(defmethod (edit-menu:create-redo?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:redo-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote redo)))) #t)) " ")
+@(defmethod (edit-menu:redo-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote redo)))) #t)) " ")
 
-@(defmethod (edit-menu:redo-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote redo))))) (send item enable enable?))))
+@(defmethod (edit-menu:redo-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote redo))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:redo-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant redo-menu-item)) ".")
+@(defmethod (edit-menu:redo-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant redo-menu-item)) ".")
 
-@(defmethod (edit-menu:redo-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant redo-info)) ".")
+@(defmethod (edit-menu:redo-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant redo-info)) ".")
 
-@(defmethod (edit-menu:between-redo-and-cut (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "redo") " and the " (tt "cut") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-redo-and-cut (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "redo") " and the " (tt "cut") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-cut-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-cut?) ").")
+@(defmethod (edit-menu:get-cut-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-cut?) ").")
 
 @(defmethod (edit-menu:create-cut?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:cut-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote cut)))) #t)) " ")
+@(defmethod (edit-menu:cut-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote cut)))) #t)) " ")
 
-@(defmethod (edit-menu:cut-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote cut))))) (send item enable enable?))))
+@(defmethod (edit-menu:cut-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote cut))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:cut-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant cut-menu-item)) ".")
+@(defmethod (edit-menu:cut-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant cut-menu-item)) ".")
 
-@(defmethod (edit-menu:cut-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant cut-info)) ".")
+@(defmethod (edit-menu:cut-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant cut-info)) ".")
 
-@(defmethod (edit-menu:between-cut-and-copy (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "cut") " and the " (tt "copy") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-cut-and-copy (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "cut") " and the " (tt "copy") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-copy-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-copy?) ").")
+@(defmethod (edit-menu:get-copy-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-copy?) ").")
 
 @(defmethod (edit-menu:create-copy?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:copy-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote copy)))) #t)) " ")
+@(defmethod (edit-menu:copy-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote copy)))) #t)) " ")
 
-@(defmethod (edit-menu:copy-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote copy))))) (send item enable enable?))))
+@(defmethod (edit-menu:copy-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote copy))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:copy-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant copy-menu-item)) ".")
+@(defmethod (edit-menu:copy-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant copy-menu-item)) ".")
 
-@(defmethod (edit-menu:copy-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant copy-info)) ".")
+@(defmethod (edit-menu:copy-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant copy-info)) ".")
 
-@(defmethod (edit-menu:between-copy-and-paste (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "copy") " and the " (tt "paste") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-copy-and-paste (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "copy") " and the " (tt "paste") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-paste-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-paste?) ").")
+@(defmethod (edit-menu:get-paste-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-paste?) ").")
 
 @(defmethod (edit-menu:create-paste?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:paste-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote paste)))) #t)) " ")
+@(defmethod (edit-menu:paste-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote paste)))) #t)) " ")
 
-@(defmethod (edit-menu:paste-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote paste))))) (send item enable enable?))))
+@(defmethod (edit-menu:paste-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote paste))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:paste-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant paste-menu-item)) ".")
+@(defmethod (edit-menu:paste-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant paste-menu-item)) ".")
 
-@(defmethod (edit-menu:paste-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant paste-info)) ".")
+@(defmethod (edit-menu:paste-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant paste-info)) ".")
 
-@(defmethod (edit-menu:between-paste-and-clear (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "paste") " and the " (tt "clear") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-paste-and-clear (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "paste") " and the " (tt "clear") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-clear-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-clear?) ").")
+@(defmethod (edit-menu:get-clear-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-clear?) ").")
 
 @(defmethod (edit-menu:create-clear?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:clear-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote clear)))) #t)) " ")
+@(defmethod (edit-menu:clear-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote clear)))) #t)) " ")
 
-@(defmethod (edit-menu:clear-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote clear))))) (send item enable enable?))))
+@(defmethod (edit-menu:clear-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote clear))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:clear-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (if (eq? (system-type) (quote windows)) (string-constant clear-menu-item-windows) (string-constant clear-menu-item-windows))) ".")
+@(defmethod (edit-menu:clear-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (if (eq? (system-type) (quote windows)) (string-constant clear-menu-item-windows) (string-constant clear-menu-item-windows))) ".")
 
-@(defmethod (edit-menu:clear-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant clear-info)) ".")
+@(defmethod (edit-menu:clear-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant clear-info)) ".")
 
-@(defmethod (edit-menu:between-clear-and-select-all (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "clear") " and the " (tt "select-all") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-clear-and-select-all (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "clear") " and the " (tt "select-all") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-select-all-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-select-all?) ").")
+@(defmethod (edit-menu:get-select-all-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-select-all?) ").")
 
 @(defmethod (edit-menu:create-select-all?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #t) ".")
 
-@(defmethod (edit-menu:select-all-callback (menu (is-a?/c menu-item<%>)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote select-all)))) #t)) " ")
+@(defmethod (edit-menu:select-all-callback (menu (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (let ((edit (get-edit-target-object))) (when (and edit (is-a? edit editor<%>)) (send edit do-edit-operation (quote select-all)))) #t)) " ")
 
-@(defmethod (edit-menu:select-all-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote select-all))))) (send item enable enable?))))
+@(defmethod (edit-menu:select-all-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (let* ((editor (get-edit-target-object)) (enable? (and editor (is-a? editor editor<%>) (send editor can-do-edit-operation? (quote select-all))))) (send item enable enable?))))
 
-@(defmethod (edit-menu:select-all-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant select-all-menu-item)) ".")
+@(defmethod (edit-menu:select-all-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant select-all-menu-item)) ".")
 
-@(defmethod (edit-menu:select-all-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant select-all-info)) ".")
+@(defmethod (edit-menu:select-all-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant select-all-info)) ".")
 
-@(defmethod (edit-menu:between-select-all-and-find (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "select-all") " and the " (tt "find") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-select-all-and-find (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "select-all") " and the " (tt "find") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-find-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find?) ").")
+@(defmethod (edit-menu:get-find-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find?) ").")
 
 @(defmethod (edit-menu:create-find?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:find-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:find-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:find-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
+@(defmethod (edit-menu:find-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
 
-@(defmethod (edit-menu:find-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant find-menu-item)) ".")
+@(defmethod (edit-menu:find-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant find-menu-item)) ".")
 
-@(defmethod (edit-menu:find-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-info)) ".")
+@(defmethod (edit-menu:find-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-info)) ".")
 
-@(defmethod (edit-menu:get-find-next-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find-next?) ").")
+@(defmethod (edit-menu:get-find-next-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find-next?) ").")
 
 @(defmethod (edit-menu:create-find-next?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:find-next-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:find-next-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:find-next-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
+@(defmethod (edit-menu:find-next-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
 
-@(defmethod (edit-menu:find-next-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant find-next-menu-item)) ".")
+@(defmethod (edit-menu:find-next-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant find-next-menu-item)) ".")
 
-@(defmethod (edit-menu:find-next-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-next-info)) ".")
+@(defmethod (edit-menu:find-next-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-next-info)) ".")
 
-@(defmethod (edit-menu:get-find-previous-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find-previous?) ").")
+@(defmethod (edit-menu:get-find-previous-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find-previous?) ").")
 
 @(defmethod (edit-menu:create-find-previous?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:find-previous-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:find-previous-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:find-previous-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
+@(defmethod (edit-menu:find-previous-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
 
-@(defmethod (edit-menu:find-previous-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant find-previous-menu-item)) ".")
+@(defmethod (edit-menu:find-previous-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant find-previous-menu-item)) ".")
 
-@(defmethod (edit-menu:find-previous-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-previous-info)) ".")
+@(defmethod (edit-menu:find-previous-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-previous-info)) ".")
 
-@(defmethod (edit-menu:get-show/hide-replace-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-show/hide-replace?) ").")
+@(defmethod (edit-menu:get-show/hide-replace-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-show/hide-replace?) ").")
 
 @(defmethod (edit-menu:create-show/hide-replace?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:show/hide-replace-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:show/hide-replace-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:show/hide-replace-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (edit-menu:show/hide-replace-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (edit-menu:show/hide-replace-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant show-replace-menu-item)) ".")
+@(defmethod (edit-menu:show/hide-replace-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant show-replace-menu-item)) ".")
 
-@(defmethod (edit-menu:show/hide-replace-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant show/hide-replace-info)) ".")
+@(defmethod (edit-menu:show/hide-replace-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant show/hide-replace-info)) ".")
 
-@(defmethod (edit-menu:get-replace-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-replace?) ").")
+@(defmethod (edit-menu:get-replace-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-replace?) ").")
 
 @(defmethod (edit-menu:create-replace?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:replace-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:replace-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:replace-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (edit-menu:replace-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (edit-menu:replace-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant replace-menu-item)) ".")
+@(defmethod (edit-menu:replace-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant replace-menu-item)) ".")
 
-@(defmethod (edit-menu:replace-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant replace-info)) ".")
+@(defmethod (edit-menu:replace-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant replace-info)) ".")
 
-@(defmethod (edit-menu:get-replace-all-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-replace-all?) ").")
+@(defmethod (edit-menu:get-replace-all-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-replace-all?) ").")
 
 @(defmethod (edit-menu:create-replace-all?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:replace-all-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:replace-all-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:replace-all-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (edit-menu:replace-all-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (edit-menu:replace-all-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant replace-all-menu-item)) ".")
+@(defmethod (edit-menu:replace-all-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant replace-all-menu-item)) ".")
 
-@(defmethod (edit-menu:replace-all-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant replace-all-info)) ".")
+@(defmethod (edit-menu:replace-all-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant replace-all-info)) ".")
 
-@(defmethod (edit-menu:get-find-case-sensitive-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find-case-sensitive?) ").")
+@(defmethod (edit-menu:get-find-case-sensitive-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-find-case-sensitive?) ").")
 
 @(defmethod (edit-menu:create-find-case-sensitive?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (edit-menu:find-case-sensitive-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (edit-menu:find-case-sensitive-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (edit-menu:find-case-sensitive-on-demand (item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
+@(defmethod (edit-menu:find-case-sensitive-on-demand (item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (send item enable (let ((target (get-edit-target-object))) (and target (is-a? target editor<%>))))))
 
-@(defmethod (edit-menu:find-case-sensitive-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant find-case-sensitive-menu-item)) ".")
+@(defmethod (edit-menu:find-case-sensitive-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant find-case-sensitive-menu-item)) ".")
 
-@(defmethod (edit-menu:find-case-sensitive-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-case-sensitive-info)) ".")
+@(defmethod (edit-menu:find-case-sensitive-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant find-case-sensitive-info)) ".")
 
-@(defmethod (edit-menu:between-find-and-preferences (menu (is-a?/c menu-item<%>))) void? "This method is called between the addition of the" "\n" (tt "find") " and the " (tt "preferences") " menu-item." "\n" "Override it to add additional menu items at that point. ")
+@(defmethod (edit-menu:between-find-and-preferences (menu (is-a?/c menu-item%))) void? "This method is called between the addition of the" "\n" (tt "find") " and the " (tt "preferences") " menu-item." "\n" "Override it to add additional menu items at that point. ")
 
-@(defmethod (edit-menu:get-preferences-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-preferences?) ").")
+@(defmethod (edit-menu:get-preferences-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> edit-menu:create-preferences?) ").")
 
 @(defmethod (edit-menu:create-preferences?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket (not (current-eventspace-has-standard-menus?))) ".")
 
-@(defmethod (edit-menu:preferences-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (preferences:show-dialog) #t)) " ")
+@(defmethod (edit-menu:preferences-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (begin (preferences:show-dialog) #t)) " ")
 
-@(defmethod (edit-menu:preferences-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (edit-menu:preferences-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (edit-menu:preferences-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant preferences-menu-item)) ".")
+@(defmethod (edit-menu:preferences-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant preferences-menu-item)) ".")
 
-@(defmethod (edit-menu:preferences-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant preferences-info)) ".")
+@(defmethod (edit-menu:preferences-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant preferences-info)) ".")
 
-@(defmethod (edit-menu:after-preferences (menu (is-a?/c menu-item<%>))) void? "This method is called " "after" " the addition of the" "\n" (tt "preferences") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
+@(defmethod (edit-menu:after-preferences (menu (is-a?/c menu-item%))) void? "This method is called " "after" " the addition of the" "\n" (tt "preferences") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
 
-@(defmethod (help-menu:before-about (menu (is-a?/c menu-item<%>))) void? "This method is called " "before" " the addition of the" "\n" (tt "about") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
+@(defmethod (help-menu:before-about (menu (is-a?/c menu-item%))) void? "This method is called " "before" " the addition of the" "\n" (tt "about") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
 
-@(defmethod (help-menu:get-about-item) (or/c false/c (is-a?/c menu-item<%>)) "This method returns the " (racket menu-item<%>) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> help-menu:create-about?) ").")
+@(defmethod (help-menu:get-about-item) (or/c false/c (is-a?/c menu-item%)) "This method returns the " (racket menu-item%) " object corresponding" "\n" "to this menu item, if it has been created (as controlled by" "\n" (method frame:standard-menus<%> help-menu:create-about?) ").")
 
 @(defmethod (help-menu:create-about?) boolean? "The result of this method determines if the corresponding" "\n" "menu item is created. Override it to control the creation of the menu item." "\n" "\n" "Defaults to " (racket #f) ".")
 
-@(defmethod (help-menu:about-callback (item (is-a?/c menu-item<%>)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
+@(defmethod (help-menu:about-callback (item (is-a?/c menu-item%)) (control (is-a?/c control-event%))) void? "Defaults to " (racketblock (void)) " ")
 
-@(defmethod (help-menu:about-on-demand (menu-item (is-a?/c menu-item<%>))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
+@(defmethod (help-menu:about-on-demand (menu-item (is-a?/c menu-item%))) void? "The menu item's on-demand proc calls this method." "\n" "\n" "Defaults to " (racketblock (void)))
 
-@(defmethod (help-menu:about-string) string? "The result of this method is used as the name of the " (racket menu-item<%>) "." "\n" "\n" "Defaults to " (racket (string-constant about-menu-item)) ".")
+@(defmethod (help-menu:about-string) string? "The result of this method is used as the name of the " (racket menu-item%) "." "\n" "\n" "Defaults to " (racket (string-constant about-menu-item)) ".")
 
-@(defmethod (help-menu:about-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item<%>) " object is created." "\n" "\n" "Defaults to " (racket (string-constant about-info)) ".")
+@(defmethod (help-menu:about-help-string) string? "The result of this method is used as the help string" "\n" "when the " (racket menu-item%) " object is created." "\n" "\n" "Defaults to " (racket (string-constant about-info)) ".")
 
-@(defmethod (help-menu:after-about (menu (is-a?/c menu-item<%>))) void? "This method is called " "after" " the addition of the" "\n" (tt "about") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
+@(defmethod (help-menu:after-about (menu (is-a?/c menu-item%))) void? "This method is called " "after" " the addition of the" "\n" (tt "about") " menu-item. Override it to add additional" "\n" "menu items at that point. ")
 
-}
+}
\ No newline at end of file
diff --git a/collects/scribblings/gui/dialog-funcs.scrbl b/collects/scribblings/gui/dialog-funcs.scrbl
index e3e761aacb..ff1629940d 100644
--- a/collects/scribblings/gui/dialog-funcs.scrbl
+++ b/collects/scribblings/gui/dialog-funcs.scrbl
@@ -14,8 +14,9 @@ These functions get input from the user and/or display
                    [directory (or/c path-string? #f) #f]
                    [filename (or/c path-string? #f) #f]
                    [extension (or/c string? #f) #f]
-                   [style (listof (or/c 'packages 'enter-packages)) null]
-                   [filters (listof (list/c string? string?)) '(("Any" "*.*"))])
+                   [style (listof (or/c 'packages 'enter-packages 'common)) null]
+                   [filters (listof (list/c string? string?)) '(("Any" "*.*"))]
+                   [#:dialog-mixin dialog-mixin (make-mixin-contract path-dialog%) (λ (x) x)])
          (or/c path? #f)]{
 
 Obtains a file pathname from the user via the platform-specific
@@ -65,8 +66,10 @@ On Windows and Unix, @racket[filters] determines a set of filters from
  that have any of these suffixes in any filter are selectable; a
  @racket["*.*"] glob makes all files available for selection.
 
-See also @racket[path-dialog%].
+The @racket[dialog-mixin] is applied to @racket[path-dialog%] before
+creating an instance of the class for this dialog.
 
+See also @racket[path-dialog%] for a richer interface.
 
 }
 
@@ -75,8 +78,9 @@ See also @racket[path-dialog%].
                         [directory (or/c path-string? #f) #f]
                         [filename (or/c path-string? #f) #f]
                         [extension (or/c string? #f) #f]
-                        [style null? null]
-                        [filters (listof (list/c string? string?)) '(("Any" "*.*"))])
+                        [style (listof (or/c 'packages 'enter-packages 'common)) null]
+                        [filters (listof (list/c string? string?)) '(("Any" "*.*"))]
+                        [#:dialog-mixin dialog-mixin (make-mixin-contract path-dialog%) (λ (x) x)])
          (or/c (listof path?) #f)]{
 Like
 @racket[get-file], except that the user can select multiple files, and the
@@ -89,8 +93,9 @@ Like
                    [directory (or/c path-string? #f) #f]
                    [filename (or/c path-string? #f) #f]
                    [extension (or/c string? #f) #f]
-                   [style (listof (or/c 'packages 'enter-packages)) null]
-                   [filters (listof (list/c string? string?)) '(("Any" "*.*"))])
+                   [style (listof (or/c 'packages 'enter-packages 'common)) null]
+                   [filters (listof (list/c string? string?)) '(("Any" "*.*"))]
+                   [#:dialog-mixin dialog-mixin (make-mixin-contract path-dialog%) (λ (x) x)])
          (or/c path? #f)]{
 
 Obtains a file pathname from the user via the platform-specific
@@ -149,14 +154,17 @@ On Unix, @racket[extension] is ignored, and @racket[filters] is used
 
 The @racket[style] list is treated as for @racket[get-file].
 
-See also @racket[path-dialog%].
+The @racket[dialog-mixin] is applied to @racket[path-dialog%] before
+creating an instance of the class for this dialog.
 
+See also @racket[path-dialog%] for a richer interface.
 }
 
 @defproc[(get-directory [message (or/c string? #f) #f]
                         [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
                         [directory (or/c path? #f) #f]
-                        [style (listof (or/c 'enter-packages)) null])
+                        [style (listof (or/c 'enter-packages 'common)) null]
+                        [#:dialog-mixin dialog-mixin (make-mixin-contract path-dialog%) (λ (x) x)])
          (or/c path #f)]{
 
 Obtains a directory pathname from the user via the platform-specific
@@ -178,13 +186,18 @@ specified.  The latter
  package. A package is a directory with a special suffix (e.g.,
  ``.app'') that the Finder normally displays like a file.
 
-See also @racket[path-dialog%].
+The @racket[dialog-mixin] is applied to @racket[path-dialog%] before
+creating an instance of the class for this dialog.
+
+See also @racket[path-dialog%] for a richer interface.
+
 }
 
 @defproc[(message-box [title label-string?]
                       [message string?]
                       [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
-                      [style (listof (or/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)])
+                      [style (listof (or/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)]
+                      [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
          (or/c 'ok 'cancel 'yes 'no)]{
 
 See also @racket[message-box/custom].
@@ -227,10 +240,14 @@ The class that implements the dialog provides a @racket[get-message]
  a string. (The dialog is accessible through the
  @racket[get-top-level-windows] function.)
 
-The @racket[message-box] function can be called int a thread other
+The @racket[message-box] function can be called in a thread other
  than the handler thread of the relevant eventspace (i.e., the eventspace of
  @racket[parent], or the current eventspace if @racket[parent] is @racket[#f]), in which case the
- current thread blocks while the dialog runs on the handler thread.}
+ current thread blocks while the dialog runs on the handler thread.
+ 
+The @racket[dialog-mixin] argument is applied to the class that implements the dialog
+before the dialog is created. 
+}
 
 @defproc[(message-box/custom [title label-string?]
                              [message string]
@@ -242,7 +259,8 @@ The @racket[message-box] function can be called int a thread other
                                                   'disallow-close 'no-default 
                                                   'default=1 'default=2 'default=3))
                                    '(no-default)]
-                             [close-result any/c #f])
+                             [close-result any/c #f]
+                             [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
          (or/c 1 2 3 close-result)]{
 
 Displays a message to the user in a (modal) dialog, using
@@ -312,10 +330,14 @@ The class that implements the dialog provides a @racket[get-message]
  a string. (The dialog is accessible through the
 @racket[get-top-level-windows] function.)
 
-The @racket[message-box/custom] function can be called int a thread
+The @racket[message-box/custom] function can be called in a thread
  other than the handler thread of the relevant eventspace (i.e., the eventspace of
  @racket[parent], or the current eventspace if @racket[parent] is @racket[#f]), in which case the
- current thread blocks while the dialog runs on the handler thread.}
+ current thread blocks while the dialog runs on the handler thread.
+ 
+The @racket[dialog-mixin] argument is applied to the class that implements the dialog
+before the dialog is created. 
+}
 
 @defproc[(message+check-box [title label-string?]
                             [message string?]
@@ -323,7 +345,8 @@ The @racket[message-box/custom] function can be called int a thread
                             [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
                             [style (listof (or/c 'ok 'ok-cancel 'yes-no 
                                                  'caution 'stop 'checked))
-                              '(ok)])
+                              '(ok)]
+                            [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
          (values (or/c 'ok 'cancel 'yes 'no) boolean?)]{
 
 See also @racket[message+check-box/custom].
@@ -349,7 +372,8 @@ Like @racket[message-box], except that
                                                         'disallow-close 'no-default 
                                                         'default=1 'default=2 'default=3))
                                           '(no-default)]
-                                   [close-result any/c #f])
+                                   [close-result any/c #f]
+                                   [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
          (or/c 1 2 3 (λ (x) (eq? x close-result)))]{
 
 Like @racket[message-box/custom], except that
@@ -360,17 +384,14 @@ Like @racket[message-box/custom], except that
  @item{@racket[style] can contain @racket['checked] to indicate that the check box
        should be initially checked.}
 ]
-
-
-
-
 }
 
 @defproc[(get-text-from-user [title string?]
                              [message (or/c string? #f)]
                              [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
                              [init-val string? ""]
-                             [style (listof 'password) null])
+                             [style (listof 'password) null]
+                             [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values]) 
          (or/c string? #f)]{
 
 Gets a text string from the user via a modal dialog, using
@@ -386,8 +407,8 @@ If @racket[style] includes @racket['password], the dialog's text field
  draws each character of its content using a generic symbol, instead
  of the actual character.
 
-
-
+The @racket[dialog-mixin] argument is applied to the class that implements the dialog
+before the dialog is created. 
 }
 
 @defproc[(get-choices-from-user [title string?]
diff --git a/collects/scribblings/guide/dialects.scrbl b/collects/scribblings/guide/dialects.scrbl
index 592426fb78..e9a8b5db2d 100644
--- a/collects/scribblings/guide/dialects.scrbl
+++ b/collects/scribblings/guide/dialects.scrbl
@@ -42,7 +42,7 @@ including the following:
 
  @item{@racketmodname[typed/racket] --- like
        @racketmodname[racket], but statically typed; see
-       @other-manual['(lib "typed-scheme/scribblings/ts-guide.scrbl")]}
+       @other-manual['(lib "typed-racket/scribblings/ts-guide.scrbl")]}
 
  @item{@racketmodname[lazy] --- like @racketmodname[racket/base], but
        avoids evaluating an expression until its value is needed; see
diff --git a/collects/scribblings/guide/performance.scrbl b/collects/scribblings/guide/performance.scrbl
index c52339611d..a1ff2a9a79 100644
--- a/collects/scribblings/guide/performance.scrbl
+++ b/collects/scribblings/guide/performance.scrbl
@@ -394,3 +394,4 @@ argument instead.
 @; ----------------------------------------------------------------------
 
 @include-section["futures.scrbl"]
+@include-section["places.scrbl"]
diff --git a/collects/scribblings/guide/places.scrbl b/collects/scribblings/guide/places.scrbl
new file mode 100644
index 0000000000..f0bafd87e5
--- /dev/null
+++ b/collects/scribblings/guide/places.scrbl
@@ -0,0 +1,96 @@
+#lang scribble/doc
+@(require scribble/manual "guide-utils.rkt"
+          (for-label racket/flonum racket/place))
+
+@title[#:tag "effective-places"]{Parallelism with Places}
+
+The @racketmodname[racket/place] library provides support for
+performance improvement through parallelism with the @racket[place]
+form. The @racket[place] form creates a @deftech{place}, which is
+effectively a new Racket instance that can run in parallel to other
+places, including the initial place.  The full power of the Racket
+language is available at each place, but places can communicate only
+through message passing---using the @racket[place-channel-put] and
+@racket[place-channel-get] functions on a limited set of
+values---which helps ensure the safety and independence of parallel
+computations.
+
+As a starting example, the racket program below uses a @tech{place} to
+determine whether any number in the list has a double that is also in
+the list:
+
+@codeblock{
+#lang racket
+
+(provide main)
+
+(define (any-double? l)
+  (for/or ([i (in-list l)])
+    (for/or ([i2 (in-list l)])
+      (= i2 (* 2 i)))))
+
+(define (main)
+  (define p 
+    (place ch
+      (define l (place-channel-get ch))
+      (define l-double? (any-double? l))
+      (place-channel-put ch l-double?)))
+
+  (place-channel-put p (list 1 2 4 8))
+  (begin0
+   (place-channel-get p))
+   (place-wait p))
+}
+
+The identifier @racket[ch] after @racket[place] is bound to a @deftech{place
+channel}. The remaining body expressions within the @racket[place] form
+are evaluated in a new place, and the body expressions use @racket[ch]
+to communicate with the place that spawned the new place.
+
+In the body of the @racket[place] form above, the new place receives a
+list of numbers over @racket[ch] and binds the list to @racket[l].  It
+then calls @racket[any-double?] on the list and binds the result to
+@racket[l-double?]. The final body expression sends the
+@racket[l-double?] result back to the original place over @racket[ch].
+
+In DrRacket, after saving and running the above program, evaluate
+@racket[(main)] in the interactions window to create the new
+place. @margin-note*{When using @tech{places} inside DrRacket, the
+module containg place code must be saved to a file before it will
+execute.}  Alternatively, save the program as @filepath{double.rkt}
+and run from a command line with
+
+@commandline{racket -tm double.rkt}
+
+where the @Flag{t} flag tells @exec{racket} to load the
+@tt{double.rkt} module, the @Flag{m} flag calls the exported
+@racket[main] function, and @Flag{tm} combines the two flags.
+
+The @racket[place] form has two subtle features. First, it lifts the
+@racket[place] body to an anonymous, module-level function.  This
+lifting means that any binding referenced by the @racket[place] body
+must be available in the module's top level. Second, the
+@racket[place] form @racket[dynamic-require]s the enclosing module in
+a newly created place. As part of the @racket[dynamic-require], the
+current module body is evaluated in the new place.  The consequence of
+this second feature is that @racket[place] should appear immediately
+in a module or in a function that is called in a module's top level;
+otherwise, invoking the module will invoke the same module in a new
+place, and so on, triggering a cascade of place creations that will
+soon exhaust memory.
+
+@codeblock{
+#lang racket
+
+(provide main)
+
+; Don't do this!
+(define p (place ch (place-channel-get ch)))
+
+(define (indirect-place-invocation)
+  (define p2 (place ch (place-channel-get ch))))
+
+; Don't do this, either!
+(indirect-place-invocation)
+}
+
diff --git a/collects/scribblings/guide/proc-macros.scrbl b/collects/scribblings/guide/proc-macros.scrbl
index b01ba6bb3f..fe251289f3 100644
--- a/collects/scribblings/guide/proc-macros.scrbl
+++ b/collects/scribblings/guide/proc-macros.scrbl
@@ -352,19 +352,20 @@ make all of these modes treat code consistently, Racket separates the
 binding spaces for different phases.
 
 To define a @racket[check-ids] function that can be referenced at
-compile time, use @racket[define-for-syntax]:
+compile time, use @racket[begin-for-syntax]:
 
 @racketblock/eval[
 #:eval check-eval
-(define-for-syntax (check-ids stx forms)
-  (for-each
-   (lambda (form)
-     (unless (identifier? form)
-       (raise-syntax-error #f
-                           "not an identifier"
-                           stx
-                           form)))
-   (syntax->list forms)))
+(begin-for-syntax
+  (define (check-ids stx forms)
+    (for-each
+     (lambda (form)
+       (unless (identifier? form)
+         (raise-syntax-error #f
+                             "not an identifier"
+                             stx
+                             form)))
+     (syntax->list forms))))
 ]
 
 With this for-syntax definition, then @racket[swap] works:
@@ -446,6 +447,7 @@ the right-hand side of the inner @racket[define-syntax] is in the
 2}. To import @racket[syntax-case] into that phase level, you would
 have to use @racket[(require (for-syntax (for-syntax racket/base)))]
 or, equivalently, @racket[(require (for-meta 2 racket/base))].  For example,
+
 @codeblock|{
 #lang racket/base
 (require  ;; This provides the bindings for the definition
diff --git a/collects/scribblings/raco/exe.scrbl b/collects/scribblings/raco/exe.scrbl
index 71fa170e8f..2d02b26628 100644
--- a/collects/scribblings/raco/exe.scrbl
+++ b/collects/scribblings/raco/exe.scrbl
@@ -37,7 +37,7 @@ Library modules or other files that are referenced
 dynamically---through @racket[eval], @racket[load], or
 @racket[dynamic-require]---are not automatically embedded into the
 created executable. Such modules can be explicitly included using the
-@DFlag{lib} flag to @exec{raco exe}. Alternately, use
+@DPFlag{lib} flag to @exec{raco exe}. Alternately, use
 @racket[define-runtime-path] to embed references to the run-time files
 in the executable; the files are then copied and packaged together
 with the executable when creating a distribution (as described in
diff --git a/collects/scribblings/raco/make.scrbl b/collects/scribblings/raco/make.scrbl
index 3abbaee883..a39c3a0921 100644
--- a/collects/scribblings/raco/make.scrbl
+++ b/collects/scribblings/raco/make.scrbl
@@ -389,12 +389,20 @@ result will not call @racket[proc] with @racket['unlock].)
 ]
 }
 
-@defproc[(compile-lock->parallel-lock-client [pc place-channel?])
+@defproc[(compile-lock->parallel-lock-client [pc place-channel?] [cust (or/c #f custodian?) #f])
          (-> (or/c 'lock 'unlock) bytes? boolean?)]{
 
   Returns a function that follows the @racket[parallel-lock-client]
   by communicating over @racket[pc]. The argument must have 
   be the result of @racket[make-compile-lock].
+  
+  This communication protocol implementation is not kill safe. To make it kill safe,
+  it needs a sufficiently powerful custodian, i.e., one that is not subject to
+  termination (unless all of the participants in the compilation are also terminated).
+  It uses this custodian to create a thread that monitors the threads that are
+  doing the compilation. If one of them is terminated, the presence of the
+  custodian lets another one continue. (The custodian is also used to create
+  a thread that manages a thread safe table.)
 }
 
 @defproc[(make-compile-lock) place-channel?]{
diff --git a/collects/scribblings/raco/zo-struct.scrbl b/collects/scribblings/raco/zo-struct.scrbl
index 1840367273..a08ebf4522 100644
--- a/collects/scribblings/raco/zo-struct.scrbl
+++ b/collects/scribblings/raco/zo-struct.scrbl
@@ -106,26 +106,28 @@ structures that are produced by @racket[zo-parse] and consumed by
 @defstruct+[(def-syntaxes form) ([ids (listof symbol?)]
                                  [rhs (or/c expr? seq? any/c)]
                                  [prefix prefix?]
-                                 [max-let-depth exact-nonnegative-integer?])]
-@defstruct+[(def-for-syntax form)
-            ([ids (listof toplevel?)]
-             [rhs (or/c expr? seq? any/c)]
+                                 [max-let-depth exact-nonnegative-integer?]
+                                 [dummy (or/c toplevel? #f)])]
+@defstruct+[(seq-for-syntax form)
+            ([forms (listof (or/c form? any/c))]
              [prefix prefix?]
-             [max-let-depth exact-nonnegative-integer?])]
+             [max-let-depth exact-nonnegative-integer?]
+             [dummy (or/c toplevel? #f)])]
 )]{
   Represents a @racket[define-syntaxes] or
-  @racket[define-values-for-syntax] form.  The @racket[rhs] expression
-  has its own @racket[prefix], which is pushed before evaluating
-  @racket[rhs]; the stack is restored after obtaining the result values.
+  @racket[begin-for-syntax] form.  The @racket[rhs] expression or set of
+  @racket[forms] forms has its own @racket[prefix], which is pushed before evaluating
+  @racket[rhs] or the @racket[forms]; the stack is restored after obtaining the result values.
   The @racket[max-let-depth] field indicates the maximum size of the
   stack that will be created by @racket[rhs] (not counting
-  @racket[prefix]).}
+  @racket[prefix]).  The @racket[dummy] variable is used to access the enclosing 
+  namespace.}
 
 @defstruct+[(req form) ([reqs stx?]
                         [dummy toplevel?])]{
   Represents a top-level @racket[#%require] form (but not one in a
   @racket[module] form) with a sequence of specifications @racket[reqs].
-  The @racket[dummy] variable is used to access to the top-level
+  The @racket[dummy] variable is used to access the top-level
   namespace.}
 
 @defstruct+[(seq form) ([forms (listof (or/c form? any/c))])]{
@@ -155,17 +157,17 @@ structures that are produced by @racket[zo-parse] and consumed by
              [requires (listof (cons/c (or/c exact-integer? #f)
                                        (listof module-path-index?)))]
              [body (listof (or/c form? any/c))]
-             [syntax-body (listof (or/c def-syntaxes? def-for-syntax?))]
-             [unexported (list/c (listof symbol?)
-                                 (listof symbol?)
-                                 (listof symbol?))]
+             [syntax-bodies  (listof (cons/c exact-positive-integer?
+                                             (listof (or/c def-syntaxes? 
+                                                           seq-for-syntax?))))]
+             [unexported (listof (list/c exact-nonnegative-integer?
+                                         (listof symbol?)
+                                         (listof symbol?)))]
              [max-let-depth exact-nonnegative-integer?]
              [dummy toplevel?]
              [lang-info (or/c #f (vector/c module-path? symbol? any/c))]
              [internal-context (or/c #f #t stx?)])]{
-  Represents a @racket[module] declaration.  The @racket[body] forms use
-  @racket[prefix], rather than any prefix in place for the module
-  declaration itself (and each @racket[syntax-body] has its own prefix).
+  Represents a @racket[module] declaration.
 
   The @racket[provides] and @racket[requires] lists are each an
   association list from phases to exports or imports.  In the case of
@@ -173,15 +175,21 @@ structures that are produced by @racket[zo-parse] and consumed by
   variables, and another for exported syntax.  In the case of
   @racket[requires], each phase maps to a list of imported module paths.
 
-  The @racket[body] field contains the module's run-time code, and
-  @racket[syntax-body] contains the module's compile-time code.  After
-  each form in @racket[body] or @racket[syntax-body] is evaluated, the
-  stack is restored to its depth from before evaluating the form.
+  The @racket[body] field contains the module's run-time (i.e., phase
+  0) code. The @racket[syntax-bodies] list has a list of forms for
+  each higher phase in the module body; the phases are in order
+  starting with phase 1.  The @racket[body] forms use @racket[prefix],
+  rather than any prefix in place for the module declaration itself,
+  while members of lists in @racket[syntax-bodies] have their own
+  prefixes. After each form in @racket[body] or @racket[syntax-bodies]
+  is evaluated, the stack is restored to its depth from before
+  evaluating the form.
 
-  The @racket[unexported] list contains lists of symbols for unexported
-  definitions that can be accessed through macro expansion.  The first
-  list is phase-0 variables, the second is phase-0 syntax, and the last
-  is phase-1 variables.
+  The @racket[unexported] list contains lists of symbols for
+  unexported definitions that can be accessed through macro expansion
+  and that are implemented through the forms in @racket[body] and
+  @racket[syntax-bodies].  Each list in @racket[unexported] starts
+  with a phase level.
 
   The @racket[max-let-depth] field indicates the maximum stack depth
   created by @racket[body] forms (not counting the @racket[prefix]
@@ -202,8 +210,8 @@ structures that are produced by @racket[zo-parse] and consumed by
             ([name symbol?]
              [src (or/c module-path-index? #f)]
              [src-name symbol?]
-             [nom-mod (or/c module-path-index? #f)]
-             [src-phase (or/c 0 1)]
+             [nom-src (or/c module-path-index? #f)]
+             [src-phase exact-nonnegative-integer?]
              [protected? boolean?])]{
   Describes an individual provided identifier within a @racket[mod]
   instance.}
diff --git a/collects/scribblings/reference/define-struct.scrbl b/collects/scribblings/reference/define-struct.scrbl
index 32619f0c74..e19f32c51f 100644
--- a/collects/scribblings/reference/define-struct.scrbl
+++ b/collects/scribblings/reference/define-struct.scrbl
@@ -236,11 +236,12 @@ preferred.
 @defform[(define-struct/derived (id . rest-form) 
            id-maybe-super (field ...) struct-option ...)]{
 
-Like @racket[define-struct], but intended for use by macros that
-expand to @racket[define-struct]. The form immediately after
-@racket[define-struct/derived] is used for all syntax-error reporting,
-and the only constraint on the form is that it starts with some
-@racket[id].
+The same as @racket[define-struct], but with an extra @racket[(id
+. rest-form)] sub-form that is treated as the overall form for
+syntax-error reporting and otherwise ignored.  The only constraint on
+the sub-form for error reporting is that it starts with @racket[id].
+The @racket[define-struct/derived] form is intended for use by macros
+that expand to @racket[define-struct].
 
 @defexamples[
 #:eval posn-eval
diff --git a/collects/scribblings/reference/eval-model.scrbl b/collects/scribblings/reference/eval-model.scrbl
index 84e8433380..2e8550449f 100644
--- a/collects/scribblings/reference/eval-model.scrbl
+++ b/collects/scribblings/reference/eval-model.scrbl
@@ -556,15 +556,18 @@ effect on further program parsing, as described in
 @secref["intro-binding"].
 
 Within a module, some definitions are shifted by a phase already; the
-@racket[define-for-syntax] form is like @racket[define], but it
-defines a variable at relative @tech{phase} 1, instead of relative
-@tech{phase} 0. Thus, if the module is @tech{instantiate}d at phase 1,
-the variables for @racket[define-for-syntax] are created at phase 2,
+@racket[begin-for-syntax] form is similar to @racket[begin], but it
+shifts expressions and definitions by a relative @tech{phase} 1. 
+Thus, if the module is @tech{instantiate}d at phase 1,
+the variables defined with @racket[begin-for-syntax] are created at phase 2,
 and so on. Moreover, this relative phase acts as another layer of
-prefixing, so that a @racket[define] of @racket[x] and a
-@racket[define-for-syntax] of @racket[x] can co-exist in a module
-without colliding. Again, the higher phases are mainly related to
-program parsing, instead of normal evaluation.
+prefixing, so that a @racket[define] of @racket[x] and a 
+@racket[begin-for-syntax]-wrapped
+@racket[define] of @racket[x] can co-exist in a module
+without colliding. A @racket[begin-for-syntax] form can be nested
+within a @racket[begin-for-syntax] form, in which case definitions and
+expressions are in relative @tech{phase} 2, and so on. Higher phases are 
+mainly related to program parsing, instead of normal evaluation.
 
 If a module @tech{instantiate}d at @tech{phase} @math{n}
 @racket[require]s another module, then the @racket[require]d module is
@@ -588,7 +591,7 @@ module forms (see @secref["mod-parse"]), and are, again, conceptually
 distinguished by prefixes.
 
 Top-level variables can exist in multiple phases in the same way as
-within modules. For example, @racket[define-for-syntax] creates a
+within modules. For example, @racket[define] within @racket[begin-for-syntax] creates a
 @tech{phase} 1 variable. Furthermore, reflective operations like
 @racket[make-base-namespace] and @racket[eval] provide access to
 top-level variables in higher @tech{phases}, while module
diff --git a/collects/scribblings/reference/match.scrbl b/collects/scribblings/reference/match.scrbl
index b5e653f50b..512874c58b 100644
--- a/collects/scribblings/reference/match.scrbl
+++ b/collects/scribblings/reference/match.scrbl
@@ -339,7 +339,7 @@ In more detail, patterns match as follows:
         @racket[quasiquote] expression form, @racketidfont{unquote}
         and @racketidfont{unquote-splicing} escape back to normal
         patterns.
-        
+
         @examples[
        #:eval match-eval
         (match '(1 2 3)
@@ -360,7 +360,7 @@ In more detail, patterns match as follows:
 			[(pat ...+) (=> id) body ...+]])]{
 Matches a sequence of values against each clause in order, matching
 only when all patterns in a clause match.  Each clause must have the
-same number of patterns as the number of @racket[val-expr]s. 
+same number of patterns as the number of @racket[val-expr]s.
 
 @examples[#:eval match-eval
 (match* (1 2 3)
@@ -368,6 +368,13 @@ same number of patterns as the number of @racket[val-expr]s.
 ]
 }
 
+@defform[(match/values expr clause clause ...)]{
+If @racket[expr] evaluates to @racket[n] values, then match all @racket[n]
+values against the patterns in @racket[clause ...]. Each clause must contain
+exactly @racket[n] patterns. At least one clause is required to determine how
+many values to expect from @racket[expr].
+}
+
 @defform[(match-lambda clause ...)]{
 
 Equivalent to @racket[(lambda (id) (match id clause ...))].
@@ -413,6 +420,14 @@ bindings of each @racket[pat] are available in each subsequent
   x)
 ]}
 
+@defform[(match-let-values ([(pat ...) expr] ...) body ...+)]{
+
+Like @racket[match-let], but generalizes @racket[let-values].}
+
+@defform[(match-let*-values ([(pat ...) expr] ...) body ...+)]{
+
+Like @racket[match-let*], but generalizes @racket[let*-values].}
+
 @defform[(match-letrec ([pat expr] ...) body ...+)]{
 
 Like @racket[match-let], but generalizes @racket[letrec].}
@@ -429,6 +444,18 @@ matching against the result of @racket[expr].
 b
 ]}
 
+@defform[(match-define-values (pat pats ...) expr)]{
+
+Like @racket[match-define] but for when expr produces multiple values.
+Like match/values, it requires at least one pattern to determine the
+number of values to expect.
+
+@examples[
+#:eval match-eval
+(match-define-values (a b) (values 1 2))
+b
+]}
+
 @; ----------------------------------------
 
 @defproc[(exn:misc:match? [v any/c]) boolean?]{
@@ -465,7 +492,7 @@ whether multiple uses of an identifier match the ``same'' value. The
 default is @racket[equal?].}
 
 @deftogether[[@defform[(match/derived val-expr original-datum clause ...)]
-              @defform[(match*/derived (val-expr ...) original-datum clause* ...)]]]{ 
+              @defform[(match*/derived (val-expr ...) original-datum clause* ...)]]]{
 Like @racket[match] and @racket[match*] respectively, but includes a
 sub-expression to be used as the source for all syntax errors within the form.
 For example, @racket[match-lambda] expands to @racket[match/derived] so that
diff --git a/collects/scribblings/reference/regexps.scrbl b/collects/scribblings/reference/regexps.scrbl
index f281586c8b..c810e9858e 100644
--- a/collects/scribblings/reference/regexps.scrbl
+++ b/collects/scribblings/reference/regexps.scrbl
@@ -1,5 +1,8 @@
 #lang scribble/doc
-@(require scribble/bnf "mz.rkt" "rx.rkt")
+@(require scribble/bnf 
+          "mz.rkt" 
+          "rx.rkt"
+          (for-syntax racket/base))
 
 @title[#:tag "regexp"]{Regular Expressions}
 
@@ -8,6 +11,27 @@
 @section-index["strings" "pattern matching"]
 @section-index["input ports" "pattern matching"]
 
+@(define-syntax (rx-examples stx)
+  (syntax-case stx ()
+   [(_ [num rx input] ...)
+    (with-syntax ([(ex ...)
+                   (map (lambda (num rx input)
+                          `(eval:alts #,(racket 
+                                         (code:line 
+                                          (regexp-match ,rx ,input) 
+                                          (code:comment @#,t["ex"
+                                                             (let ([s (number->string ,num)])
+                                                               (elemtag `(rxex ,s) 
+                                                                        (racketcommentfont s)))
+                                                             ,(if (pregexp? (syntax-e rx))
+                                                                  `(list ", uses " (racketmetafont "#px"))
+                                                                  "")])))
+                                      (regexp-match ,rx ,input)))
+                        (syntax->list #'(num ...))
+                        (syntax->list #'(rx ...))
+                        (syntax->list #'(input ...)))])
+      #`(examples ex ...))]))
+
 @guideintro["regexp"]{regular expressions}
 
 @deftech{Regular expressions} are specified as strings or byte
@@ -66,6 +90,45 @@ The Unicode categories follow.
 
 @category-table
 
+@rx-examples[
+[1 #rx"a|b" "cat"]
+[2 #rx"[at]" "cat"]
+[3 #rx"ca*[at]" "caaat"]
+[4 #rx"ca+[at]" "caaat"]
+[5 #rx"ca?t?" "ct"]
+[6 #rx"ca*?[at]" "caaat"]
+[7 #px"ca{2}" "caaat"]
+[8 #px"ca{2,}t" "catcaat"]
+[9 #px"ca{,2}t" "caaatcat"]
+[10 #px"ca{1,2}t" "caaatcat"]
+[11 #rx"(c*)(a*)" "caat"]
+[12 #rx"[^ca]" "caat"]
+[13 #rx".(.)." "cat"]
+[14 #rx"^a|^c" "cat"]
+[15 #rx"a$|t$" "cat"]
+[16 #px"c(.)\\1t" "caat"]
+[17 #px".\\b." "cat in hat"]
+[18 #px".\\B." "cat in hat"]
+[19 #px"\\p{Ll}" "Cat"]
+[20 #px"\\P{Ll}" "cat!"]
+[21 #rx"\\|" "c|t"]
+[22 #rx"[a-f]*" "cat"]
+[23 #px"[a-f\\d]*" "1cat"]
+[24 #px" [\\w]" "cat hat"]
+[25 #px"t[\\s]" "cat\nhat"]
+[26 #px"[[:lower:]]+" "Cat"]
+[27 #rx"[]]" "c]t"]
+[28 #rx"[-]" "c-t"]
+[29 #rx"[]a[]+" "c[a]t"]
+[30 #rx"[a^]+" "ca^t"]
+[31 #rx".a(?=p)" "cat nap"]
+[32 #rx".a(?!t)" "cat nap"]
+[33 #rx"(?<=n)a." "cat nap"]
+[34 #rx"(?<!c)a." "cat nap"]
+[35 #rx"(?i:a)[tp]" "cAT nAp"]
+[36 #rx"(?(?<=c)a|b)+" "cabal"]
+]
+
 @;------------------------------------------------------------------------
 @section{Additional Syntactic Constraints}
 
@@ -241,17 +304,16 @@ string, @racket[start-pos] is a character position; when
 position; and when @racket[input] is an input port, @racket[start-pos]
 is the number of bytes to skip before starting to match. The
 @racket[end-pos] argument can be @racket[#f], which corresponds to the
-end of the string or the end-of-file in the stream; otherwise, it is a
+end of the string or an end-of-file in the stream; otherwise, it is a
 character or byte position, like @racket[start-pos]. If @racket[input]
-is an input port, and if the end-of-file is reached before
+is an input port, and if an end-of-file is reached before
 @racket[start-pos] bytes are skipped, then the match fails.
 
 In @racket[pattern], a start-of-string @litchar{^} refers to the first
 position of @racket[input] after @racket[start-pos], assuming that
 @racket[input-prefix] is @racket[#""].  The end-of-input @litchar{$}
 refers to the @racket[end-pos]th position or (in the case of an input
-port) the end of file, whichever comes first, assuming that
-@racket[output-prefix] is @racket[#f].
+port) an end-of-file, whichever comes first.
 
 The @racket[input-prefix] specifies bytes that effectively precede
 @racket[input] for the purposes of @litchar{^} and other look-behind
diff --git a/collects/scribblings/reference/rx.rkt b/collects/scribblings/reference/rx.rkt
index 534a87f63a..6b8bc82747 100644
--- a/collects/scribblings/reference/rx.rkt
+++ b/collects/scribblings/reference/rx.rkt
@@ -2,69 +2,73 @@
 (require scribble/core scribble/manual scribble/bnf
          racket/list racket/string)
 
+;; If you edit this table, please try to avoid making the table wider
+;; or causing line-wrapping in HTML. (I know that someone who edits
+;; the table is unlikely to see this request, but it's worth a try.)
+
 (define grammar @string-append{
   Regexp   ::= Pces               Match Pces                                      #co
-            |  Regexp|Regexp      Match either Regexp, try left first             #co
+            |  Regexp|Regexp      Match either Regexp, try left first             #co 1
   Pces     ::= Pce                Match Pce                                       #co
             |  PcePces            Match Pce followed by Pces                      #co
-  Pce      ::= Repeat             Match Repeat, longest possible                  #co
-            |  Repeat?            Match Repeat, shortest possible                 #co
+  Pce      ::= Repeat             Match Repeat, longest possible                  #co 3
+            |  Repeat?            Match Repeat, shortest possible                 #co 6
             |  Atom               Match Atom exactly once                         #co
-  Repeat   ::= Atom*              Match Atom 0 or more times                      #co
-            |  Atom+              Match Atom 1 or more times                      #co
-            |  Atom?              Match Atom 0 or 1 times                         #co
+  Repeat   ::= Atom*              Match Atom 0 or more times                      #co 3
+            |  Atom+              Match Atom 1 or more times                      #co 4
+            |  Atom?              Match Atom 0 or 1 times                         #co 5
   Repeat   ::= ...                ...                                             #px
-            |  Atom{N}            Match Atom exactly N times                      #px
-            |  Atom{N,}           Match Atom N or more times                      #px
-            |  Atom{,M}           Match Atom between 0 and M times                #px
-            |  Atom{N,M}          Match Atom between N and M times                #px
-  Atom     ::= (Regexp)           Match sub-expression Regexp and report          #co
-            |  [Rng]              Match any character in Rng                      #co
-            |  [^Rng]             Match any character not in Rng                  #co
-            |  .                  Match any (except newline in multi mode)        #co
-            |  ^                  Match start (or after newline in multi mode)    #co
-            |  $                  Match end (or before newline in multi mode)     #co
-            |  Literal            Match a single literal character                #co
-            |  (?Mode:Regexp)     Match Regexp using Mode                         #co
+            |  Atom{N}            Match Atom exactly N times                      #px 7
+            |  Atom{N,}           Match Atom N or more times                      #px 8
+            |  Atom{,M}           Match Atom between 0 and M times                #px 9
+            |  Atom{N,M}          Match Atom between N and M times                #px 10
+  Atom     ::= (Regexp)           Match sub-expression Regexp and report          #co 11
+            |  [Rng]              Match any character in Rng                      #co 2
+            |  [^Rng]             Match any character not in Rng                  #co 12
+            |  .                  Match any (except newline in multi mode)        #co 13
+            |  ^                  Match start (or after newline in multi mode)    #co 14
+            |  $                  Match end (or before newline in multi mode)     #co 15
+            |  Literal            Match a single literal character                #co 1
+            |  (?Mode:Regexp)     Match Regexp using Mode                         #co 35
             |  (?>Regexp)         Match Regexp, only first possible               #co
             |  Look               Match empty if Look matches                     #co
-            |  (?TstPces|Pces)    Match 1st Pces if Tst, else 2nd Pces            #co
+            |  (?TstPces|Pces)    Match 1st Pces if Tst, else 2nd Pces            #co 36
             |  (?TstPces)         Match Pces if Tst, empty if not Tst             #co
   Atom     ::= ...                ...                                             #px
-            |  \N                 Match latest reported match for N##th _(_       #px
+            |  \N                 Match latest reported match for N##th _(_       #px 16
             |  Class              Match any character in Class                    #px
-            |  \b                 Match _\w*_ boundary                            #px
-            |  \B                 Match where _\b_ does not                       #px
-            |  \p{Property}       Match (UTF-8 encoded) in Property               #px
-            |  \P{Property}       Match (UTF-8 encoded) not in Property           #px
+            |  \b                 Match _\w*_ boundary                            #px 17
+            |  \B                 Match where _\b_ does not                       #px 18
+            |  \p{Property}       Match (UTF-8 encoded) in Property               #px 19
+            |  \P{Property}       Match (UTF-8 encoded) not in Property           #px 20
   Literal  :== Any character except _(_, _)_, _*_, _+_, _?_, _[_, _._, _^_, _\_, or _|_                #rx
   Literal  :== Any character except _(_, _)_, _*_, _+_, _?_, _[_, _]_, _{_, _}_, _._, _^_, _\_, or _|_ #px
-            |  \Aliteral                Match Aliteral                            #ot
+            |  \Aliteral                Match Aliteral                            #ot 21
   Aliteral :== Any character                                                      #rx
   Aliteral :== Any character except _a_-_z_, _A_-_Z_, _0_-_9_                     #px
-  Rng      ::= ]                  Rng contains _]_ only                           #co
-            |  -                  Rng contains _-_ only                           #co
+  Rng      ::= ]                  Rng contains _]_ only                           #co 27
+            |  -                  Rng contains _-_ only                           #co 28
             |  Mrng               Rng contains everything in Mrng                 #co
             |  Mrng-              Rng contains _-_ and everything in Mrng         #co
-  Mrng     ::= ]Lrng              Mrng contains _]_ and everything in Lrng        #co
-            |  -Lrng              Mrng contains _-_ and everything in Lrng        #co
+  Mrng     ::= ]Lrng              Mrng contains _]_ and everything in Lrng        #co 29
+            |  -Lrng              Mrng contains _-_ and everything in Lrng        #co 29
             |  Lirng              Mrng contains everything in Lirng               #co
   Lirng    ::= Riliteral          Lirng contains a literal character              #co
-            |  Riliteral-Rliteral Lirng contains Unicode range inclusive          #co
+            |  Riliteral-Rliteral Lirng contains Unicode range inclusive          #co 22
             |  LirngLrng          Lirng contains everything in both               #co
-  Lrng     ::= ^                  Lrng contains _^_                               #co
+  Lrng     ::= ^                  Lrng contains _^_                               #co 30
             |  Rliteral-Rliteral  Lrng contains Unicode range inclusive           #co
             |  ^Lrng              Lrng contains _^_ and more                      #co
             |  Lirng              Lrng contains everything in Lirng               #co
-  Look     ::= (?=Regexp)         Match if Regexp matches                         #mode
-            |  (?!Regexp)         Match if Regexp doesn't match                   #mode
-            |  (?<=Regexp)        Match if Regexp matches preceding               #mode
-            |  (?<!Regexp)        Match if Regexp doesn't match preceding         #mode
+  Look     ::= (?=Regexp)         Match if Regexp matches                         #mode 31
+            |  (?!Regexp)         Match if Regexp doesn't match                   #mode 32
+            |  (?<=Regexp)        Match if Regexp matches preceding               #mode 33
+            |  (?<!Regexp)        Match if Regexp doesn't match preceding         #mode 34
   Tst      ::= (N)                True if Nth _(_ has a match                     #mode
-            |  Look               True if Look matches                            #mode
+            |  Look               True if Look matches                            #mode 36
   Lirng    ::= ...                ...                                             #px
             |  Class              Lirng contains all characters in Class          #px
-            |  Posix              Lirng contains all characters in Posix          #px
+            |  Posix              Lirng contains all characters in Posix          #px 26
             |  \Eliteral          Lirng contains Eliteral                         #px
   Riliteral :== Any character except _]_, _-_, or _^_                             #rx
   Riliteral :== Any character except _]_, _\_, _-_, or _^_                        #px
@@ -72,21 +76,21 @@
   Rliteral  :== Any character except _]_, _\_, or _-_                             #px
   Eliteral  :== Any character except _a_-_z_, _A_-_Z_                             #px
   Mode     ::=                    Like the enclosing mode                         #mode
-            |  Modei              Like Mode, but case-insensitive                 #mode
+            |  Modei              Like Mode, but case-insensitive                 #mode 35
             |  Mode-i             Like Mode, but sensitive                        #mode
             |  Modes              Like Mode, but not in multi mode                #mode
             |  Mode-s             Like Mode, but in multi mode                    #mode
             |  Modem              Like Mode, but in multi mode                    #mode
             |  Mode-m             Like Mode, but not in multi mode                #mode
-  Class    ::= \d                 Contains _0_-_9_                                #cat
+  Class    ::= \d                 Contains _0_-_9_                                #cat 23
             |  \D                 Contains ASCII other than those in _\d_         #cat
-            |  \w                 Contains _a_-_z_, _A_-_Z_, _0_-_9_, ___         #cat
+            |  \w                 Contains _a_-_z_, _A_-_Z_, _0_-_9_, ___         #cat 24
             |  \W                 Contains ASCII other than those in _\w_         #cat
-            |  \s                 Contains space, tab, newline, formfeed, return  #cat
+            |  \s                 Contains space, tab, newline, formfeed, return  #cat 25
             |  \S                 Contains ASCII other than those in _\s_         #cat
   Posix    ::= [:alpha:]          Contains _a_-_z_, _A_-_Z_                       #cat
             |  [:upper:]          Contains _A_-_Z_                                #cat
-            |  [:lower:]          Contains _a_-_z_                                #cat
+            |  [:lower:]          Contains _a_-_z_                                #cat 26
             |  [:digit:]          Contains _0_-_9_                                #cat
             |  [:xdigit:]         Contains _0_-_9_, _a_-_f_, _A_-_F_              #cat
             |  [:alnum:]          Contains _a_-_z_, _A_-_Z_, _0_-_9_              #cat
@@ -94,12 +98,12 @@
             |  [:blank:]          Contains space and tab                          #cat
             |  [:space:]          Contains space, tab, newline, formfeed, return  #cat
             |  [:graph:]          Contains all ASCII characters that use ink      #cat
-            |  [:print:]          Contains space, tab, and ASCII ink users (_[:graph:]_ and _[:blank:]_) #cat
+            |  [:print:]          Contains space, tab, and ASCII ink users        #cat
             |  [:cntrl:]          Contains all characters with scalar value < 32  #cat
             |  [:ascii:]          Contains all ASCII characters                   #cat
   Property ::= Category           Includes all characters in Category             #cat
             |  ^Category          Includes all characters not in Category         #cat
-  Category ::= Ll                 Letter, lowercase                               #ucat
+  Category ::= Ll                 Letter, lowercase                               #ucat 19
             |  Lu                 Letter, uppercase                               #ucat
             |  Lt                 Letter, titlecase                               #ucat
             |  Lm                 Letter, modifier                                #ucat
@@ -192,7 +196,7 @@
   (for/list ([line (in-list (regexp-split "\r*\n" grammar))]
              #:when (positive? (string-length line)))
     (regexp-case line
-      [(#px"^(.*?) +#(\\w+)$" line kind) (cons (string->symbol kind) line)]
+      [(#px"^(.*?) +#(\\w+)(?:| ([0-9]+))$" line kind ex) (list (string->symbol kind) line ex)]
       [else (error 'grammar-lines "bad line: ~s" line)])))
 
 (define (table-content modes)
@@ -201,22 +205,29 @@
       x
       (paragraph plain (list (if (element? x) x (element #f x))))))
   (define (row . xs) (map cell xs))
-  (define (render-line line)
+  (define (ex-ref ex) (if ex
+                          (smaller (list 'nbsp (elemref `(rxex ,ex)
+                                                        (format "ex~a" ex))))
+                          ""))
+  (define (render-line line ex)
     (regexp-case line
       [(#rx"^([^ ]*) +::= ((?:[^ ]+| [|] )*) +([^ ].*)$" prod val meaning)
        (row (fixup-ids prod) ::= (lit-ize (fixup-ids val))
-            spacer (as-smaller (as-meaning (fixup-ids meaning))))]
+            spacer (as-smaller (as-meaning (fixup-ids meaning)))
+            (ex-ref ex))]
       [(#rx"^([^ ]*) +:== (.*)$" prod meaning)
        (row (fixup-ids prod) ::= (as-meaning (fixup-ids meaning))
-            'cont 'cont)]
+            'cont 'cont
+            (ex-ref ex))]
       [(#rx"^ + [|]  ((?:[^ ]| [|] )*) +([^ ].*)$" val meaning)
        (row 'nbsp -or- (lit-ize (fixup-ids val))
-            spacer (as-smaller (as-meaning (fixup-ids meaning))))]))
+            spacer (as-smaller (as-meaning (fixup-ids meaning)))
+            (ex-ref ex))]))
   (table (style #f (list (table-columns
                           (map (lambda (s) (style #f (list s)))
-                               '(left left center left left left)))))
+                               '(left left center left left left left)))))
     (for/list ([line (in-list grammar-lines)] #:when (memq (car line) modes))
-      (cons (paragraph plain (list spacer)) (render-line (cdr line))))))
+      (cons (paragraph plain (list spacer)) (render-line (cadr line) (caddr line))))))
 
 (provide common-table rx-table px-table category-table)
 (define common-table   (table-content '(co mode)))
diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl
index 8b90c7e694..18abf2101f 100644
--- a/collects/scribblings/reference/sequences.scrbl
+++ b/collects/scribblings/reference/sequences.scrbl
@@ -506,17 +506,17 @@ in the sequence.
 
 @defproc[(sequence-for-each [f (-> any/c ... any)]
                           [s sequence?])
-         (void)]{
+         void?]{
   Applies @racket[f] to each element of @racket[s].  If @racket[s] is
   infinite, this function does not terminate.}
 
 @defproc[(sequence-fold [f (-> any/c any/c ... any/c)]
                         [i any/c]
                         [s sequence?])
-         (void)]{
+         any/c]{
   Folds @racket[f] over each element of @racket[s] with @racket[i] as
   the initial accumulator.  If @racket[s] is infinite, this function
-  does not terminate. @racket[f] takes the accumulator as its first argument
+  does not terminate. The @racket[f] function takes the accumulator as its first argument
   and the next sequence element as its second.}
 
 @defproc[(sequence-count [f procedure?] [s sequence?])
@@ -650,14 +650,14 @@ when it is evaluated, otherwise the @exnraise[exn:fail:contract?].}
 
 @defproc[(stream-for-each [f (-> any/c ... any)]
                           [s stream?])
-         (void)]{
+         void?]{
   Applies @racket[f] to each element of @racket[s].  If @racket[s] is
   infinite, this function does not terminate.}
 
 @defproc[(stream-fold [f (-> any/c any/c ... any/c)]
                       [i any/c]
                       [s stream?])
-         (void)]{
+         any/c]{
   Folds @racket[f] over each element of @racket[s] with @racket[i] as
   the initial accumulator.  If @racket[s] is infinite, this function
   does not terminate.}
diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl
index fcca28afc8..c38310af17 100644
--- a/collects/scribblings/reference/startup.scrbl
+++ b/collects/scribblings/reference/startup.scrbl
@@ -242,7 +242,12 @@ flags:
   @item{@FlagFirst{X} @nonterm{dir} or @DFlagFirst{collects}
         @nonterm{dir} : Sets @nonterm{dir} as the path to the main
         collection of libraries by making @racket[(find-system-path
-        'collects-dir)] produce @nonterm{dir}.}
+        'collects-dir)] produce @nonterm{dir}. If @nonterm{dir} is an
+        empty string, then @racket[(find-system-path 'collects-dir)]
+        returns @filepath{.}, but
+        @racket[current-library-collection-paths] is initialized to
+        the empty list and @racket[use-collection-link-paths] is
+        initialized to @racket[#f].}
 
   @item{@FlagFirst{S} @nonterm{dir} or @DFlagFirst{search}
         @nonterm{dir} : Adds @nonterm{dir} to the default library
diff --git a/collects/scribblings/reference/stx-trans.scrbl b/collects/scribblings/reference/stx-trans.scrbl
index 71059b4780..efbdd493a1 100644
--- a/collects/scribblings/reference/stx-trans.scrbl
+++ b/collects/scribblings/reference/stx-trans.scrbl
@@ -473,8 +473,9 @@ to a top-level definition. A compile-time expression in a
 @racket[letrec-syntaxes+values] or @racket[define-syntaxes] binding is
 lifted to a @racket[let] wrapper around the corresponding right-hand
 side of the binding. A compile-time expression within
-@racket[begin-for-syntax] is lifted to a @racket[define-for-syntax]
-declaration just before the requesting expression.
+@racket[begin-for-syntax] is lifted to a @racket[define]
+declaration just before the requesting expression within the 
+@racket[begin-for-syntax].
 
 Other syntactic forms can capture lifts by using
 @racket[local-expand/capture-lifts] or
@@ -524,9 +525,8 @@ then the @exnraise[exn:fail:contract].}
 
 Lifts a @racket[#%require] form corresponding to
 @racket[raw-require-spec] (either as a @tech{syntax object} or datum)
-to the top-level or to the top of the module currently being expanded,
-wrapping it with @racket[for-meta] if the current expansion context is
-not @tech{phase level} 0.
+to the top-level or to the top of the module currently being expanded
+ or to an enclosing @racket[begin-for-syntax]..
 
 The resulting syntax object is the same as @racket[stx], except that a
 fresh @tech{syntax mark} is added. The same @tech{syntax mark} is
@@ -551,7 +551,7 @@ by the macro expander can prevent access to the new imports.
 
 Lifts a @racket[#%provide] form corresponding to
 @racket[raw-provide-spec-stx] to the top of the module currently being
-expanded.
+expanded or to an enclosing @racket[begin-for-syntax].
 
 @transform-time[] If the current expression being transformed is not
 within a @racket[module] form, or if it is not a run-time expression,
@@ -640,22 +640,6 @@ resulting identifier is @tech{tainted}.
 @transform-time[]}
 
 
-@defproc[(syntax-local-armer)
-         ((syntax?) (any/c any/c) . ->* . syntax?)]{
-
-Returns a procedure that captures the declaration-time code inspector
-of the module in which a syntax transformer was bound (if a syntax
-transformer is being applied) or the module being visited. The result
-is a procedure like @racket[syntax-taint-arm], except that the
-optional third argument is automatically the captured inspector.
-
-The @racket[syntax-local-armer] function is needed by
-macro-generating macros, where a syntax object in the generated macro
-needs to be protected using the code inspector of the generating
-macro's module.
-
-@transform-time[]}
-
 @defproc[(syntax-local-certifier [active? boolean? #f])
          ((syntax?) (any/c (or/c procedure? #f)) 
           . ->* . syntax?)]{
@@ -748,20 +732,20 @@ Returns @racket[#t] while a @tech{provide transformer} is running (see
 @racket[#%provide] is expanded, @racket[#f] otherwise.}
 
 
-@defproc[(syntax-local-module-defined-identifiers) 
-         (values (listof identifier?) (listof identifier?))]{
+@defproc[(syntax-local-module-defined-identifiers) (and/c hash? immutable?)]{
 
 Can be called only while
 @racket[syntax-local-transforming-module-provides?] returns
 @racket[#t].
 
-It returns two lists of identifiers corresponding to all definitions
+It returns a hash table mapping a @tech{phase-level} number (such as
+@racket[0]) to a list of all definitions at that @tech{phase level}
 within the module being expanded. This information is used for
 implementing @racket[provide] sub-forms like @racket[all-defined-out].
 
-The first result list corresponds to @tech{phase} 0 (i.e., normal)
-definitions, and the second corresponds to @tech{phase} -1 (i.e.,
-for-syntax) definitions.}
+Beware that the @tech{phase-level} keys are absolute relative to the
+enclosing module, and not relative to the current transformer phase
+level as reported by @racket[syntax-local-phase-level].}
 
 
 @defproc[(syntax-local-module-required-identifiers
@@ -785,7 +769,11 @@ with a @racket[phase-level] shift, of all shifts if
 When an identifier is renamed on import, the result association list
 includes the identifier by its internal name. Use
 @racket[identifier-binding] to obtain more information about the
-identifier.}
+identifier.
+
+Beware that the @tech{phase-level} keys are absolute relative to the
+enclosing module, and not relative to the current transformer phase
+level as reported by @racket[syntax-local-phase-level].}
 
 @deftogether[(
 @defthing[prop:liberal-define-context struct-type-property?]
diff --git a/collects/scribblings/reference/syntax-model.scrbl b/collects/scribblings/reference/syntax-model.scrbl
index 24f768dba4..0c0aa42eb5 100644
--- a/collects/scribblings/reference/syntax-model.scrbl
+++ b/collects/scribblings/reference/syntax-model.scrbl
@@ -11,19 +11,19 @@ The syntax of a Racket program is defined by
 
 @itemize[
 
- @item{a @deftech{read} phase that processes a character stream into a
+ @item{a @deftech{read} pass that processes a character stream into a
        @tech{syntax object}; and}
 
- @item{an @deftech{expand} phase that processes a syntax object to
+ @item{an @deftech{expand} pass that processes a syntax object to
        produce one that is fully parsed.}
 
 ]
 
-For details on the @tech{read} phase, see @secref["reader"]. Source
+For details on the @tech{read} pass, see @secref["reader"]. Source
 code is normally read in @racket[read-syntax] mode, which produces a
 @tech{syntax object}.
 
-The @tech{expand} phase recursively processes a @tech{syntax object}
+The @tech{expand} pass recursively processes a @tech{syntax object}
 to produce a complete @tech{parse} of the program. @tech{Binding}
 information in a @tech{syntax object} drives the @tech{expansion}
 process, and when the @tech{expansion} process encounters a
@@ -186,7 +186,7 @@ the binding (according to @racket[free-identifier=?]) matters.}
 
 @racketgrammar*[
 #:literals (#%expression module #%plain-module-begin begin #%provide
-            define-values define-syntaxes define-values-for-syntax
+            define-values define-syntaxes begin-for-syntax
             #%require
             #%plain-lambda case-lambda if begin begin0 let-values letrec-values
             set! quote-syntax quote with-continuation-mark
@@ -196,13 +196,14 @@ the binding (according to @racket[free-identifier=?]) matters.}
                 (module id name-id
                   (#%plain-module-begin
                    module-level-form ...))
-                (begin top-level-form ...)]
+                (begin top-level-form ...)
+                (begin-for-syntax top-level-form ...)]
 [module-level-form general-top-level-form
-                   (#%provide raw-provide-spec ...)]
+                   (#%provide raw-provide-spec ...)
+                   (begin-for-syntax module-level-form ...)]
 [general-top-level-form expr
                         (define-values (id ...) expr)
                         (define-syntaxes (id ...) expr)
-                        (define-values-for-syntax (id ...) expr)
                         (#%require raw-require-spec ...)]
 [expr id
       (#%plain-lambda formals expr ...+)
@@ -243,15 +244,14 @@ binding to the @racket[#%plain-lambda] of the
 syntactic-form names refer to the bindings defined in
 @secref["syntax"].
 
-Only @tech{phase levels} 0 and 1 are relevant for the parse of a
-program (though the @racket[_datum] in a @racket[quote-syntax] form
-preserves its information for all @tech{phase level}s). In particular,
-the relevant @tech{phase level} is 0, except for the @racket[_expr]s
-in a @racket[define-syntax], @racket[define-syntaxes],
-@racket[define-for-syntax], or @racket[define-values-for-syntax] form,
-in which case the relevant @tech{phase level} is 1 (for which
-comparisons are made using @racket[free-transformer-identifier=?]
-instead of @racket[free-identifier=?]).
+In a fully expanded program for a namespace whose @tech{base phase} is
+0, the relevant @tech{phase level} for a binding in the program is
+@math{N} if the bindings has @math{N} surrounding
+@racket[begin-for-syntax] and @racket[define-syntaxes] forms---not
+counting any @racket[begin-for-syntax] forms that wrap a
+@racket[module] form for the body of the @racket[module]. The
+@racket[_datum] in a @racket[quote-syntax] form, however, always
+preserves its information for all @tech{phase level}s.
 
 In addition to the grammar above, @racket[letrec-syntaxes+values] can
 appear in a fully local-expanded expression, as can
@@ -427,11 +427,13 @@ core syntactic forms are encountered:
        at @tech{phase level} 0 (i.e., the @tech{base environment} is
        extended).}
 
- @item{When a @racket[define-for-syntax] or
-       @racket[define-values-for-syntax] form is encountered at the
-       top level or module level, bindings are introduced as for
-       @racket[define-values], but at @tech{phase level} 1 (i.e., the
-       @tech{transformer environment} is extended).}
+ @item{When a @racket[begin-for-syntax] form is encountered at the top
+       level or module level, bindings are introduced as for
+       @racket[define-values] and @racket[define-syntaxes], but at
+       @tech{phase level} 1 (i.e., the @tech{transformer environment}
+       is extended). More generally, @racket[begin-for-syntax] forms
+       can be nested, an each @racket[begin-for-syntax] shifts its
+       body definition by one @tech{phase level}.}
 
  @item{When a @racket[let-values] form is encountered, the body of the
        @racket[let-values] form is extended (by creating new
@@ -578,11 +580,11 @@ to its handling of @racket[define-syntaxes]. A
 level @math{n} (not just 0), in which case the expression for the
 @tech{transformer binding} is expanded at @tech{phase level} @math{n+1}.
 
-The expression in a @racket[define-for-syntax] or
-@racket[define-values-for-syntax] form is expanded and evaluated in
-the same way as for @racket[syntax]. However, the introduced binding
-is a variable binding at @tech{phase level} 1 (not a @tech{transformer
-binding} at @tech{phase level} 0).
+The expressions in a @racket[begin-for-syntax] form are expanded and
+evaluated in the same way as for @racket[define-syntaxes]. However,
+any introduced bindings from definition within
+@racket[begin-for-syntax] are at @tech{phase level} 1 (not a
+@tech{transformer binding} at @tech{phase level} 0).
 
 @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 @subsection[#:tag "partial-expansion"]{Partial Expansion}
@@ -654,10 +656,10 @@ the @racket[letrec-syntaxes+values] form.
 
 A @racket[require] form not only introduces @tech{bindings} at
 expansion time, but also @deftech{visits} the referenced module when
-it is encountered by the expander. That is, the expander
-instantiates any @racket[define-for-syntax]ed variables defined
-in the module, and also evaluates all expressions for
-@racket[define-syntaxes] @tech{transformer bindings}.
+it is encountered by the expander. That is, the expander instantiates
+any variables defined in the module within @racket[begin-for-syntax],
+and it also evaluates all expressions for @racket[define-syntaxes]
+@tech{transformer bindings}.
 
 Module @tech{visits} propagate through @racket[require]s in the same
 way as module @tech{instantiation}. Moreover, when a module is
@@ -673,8 +675,8 @@ implicitly @tech{visit}ed. Thus, when the expander encounters
 @tech{instantiate}s the required module at @tech{phase} 1, in addition
 to adding bindings at @tech{phase level} 1 (i.e., the
 @tech{transformer environment}). Similarly, the expander immediately
-evaluates any @racket[define-values-for-syntax] form that it
-encounters.
+evaluates any form that it encounters within
+@racket[begin-for-syntax].
 
 @tech{Phases} beyond 0 are @tech{visit}ed on demand. For example,
 when the right-hand side of a @tech{phase}-0 @racket[let-syntax] is to
diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl
index 2f1245f317..3ec647c7d6 100644
--- a/collects/scribblings/reference/syntax.scrbl
+++ b/collects/scribblings/reference/syntax.scrbl
@@ -152,18 +152,26 @@ action depends on the shape of the form:
   out into the module's body and immediately processed in place of the
   @racket[begin].}
 
- @item{If it is a @racket[define-syntaxes] or
-  @racket[define-values-for-syntax] form, then the right-hand side is
+ @item{If it is a @racket[define-syntaxes] form, then the right-hand side is
   evaluated (in @tech{phase} 1), and the binding is immediately
   installed for further partial expansion within the
   module. Evaluation of the right-hand side is @racket[parameterize]d
   to set @racket[current-namespace] as in @racket[let-syntax].}
 
- @item{If the form is a @racket[require] form, bindings are introduced
+ @item{If it is a @racket[begin-for-syntax] form, then the body is
+  expanded (in @tech{phase} 1) and evaluated. Expansion within a
+  @racket[begin-for-syntax] form proceeds with the same
+  partial-expansion process as for a @racket[module] body, but in a
+  higher @tech{phase}, and saving all @racket[#%provide] forms for all
+  phases until the end of the @racket[module]'s expansion. Evaluation
+  of the body is @racket[parameterize]d to set
+  @racket[current-namespace] as in @racket[let-syntax].}
+
+ @item{If the form is a @racket[#%require] form, bindings are introduced
    immediately, and the imported modules are @tech{instantiate}d or
    @tech{visit}ed as appropriate.}
 
- @item{If the form is a @racket[provide] form, then it is recorded for
+ @item{If the form is a @racket[#%provide] form, then it is recorded for
    processing after the rest of the body.}
 
  @item{If the form is a @racket[define-values] form, then the binding
@@ -177,7 +185,9 @@ action depends on the shape of the form:
 
 After all @racket[form]s have been partially expanded this way, then
 the remaining expression forms (including those on the right-hand side
-of a definition) are expanded in an expression context.
+of a definition) are expanded in an expression context. Finally,
+@racket[#%provide] forms are processed in the order in which they
+appear (independent of @tech{phase}) in the expanded module.
 
 The scope of all imported identifiers covers the entire module body,
 as does the scope of any identifier defined within the module body.
@@ -707,7 +717,10 @@ A @racket[provide-spec] indicates one or more bindings to provide.
 For each exported binding, the external name is a symbol that can be
 different from the symbolic form of the identifier that is bound
 within the module. Also, each export is drawn from a particular
-@tech{phase level} and exported at the same @tech{phase level}.
+@tech{phase level} and exported at the same @tech{phase level}; by
+default, the relevant phase level is the number of
+@racket[begin-for-syntax] forms that enclose the @racket[provide]
+form.
 
 The syntax of @racket[provide-spec] can be extended via
 @racket[define-provide-syntax], but the pre-defined forms are as
@@ -733,7 +746,7 @@ follows.
  @racket[make-rename-transformer] for more information.}
 
  @defsubform[(all-defined-out)]{ Exports all identifiers that are
- defined at @tech{phase level} 0 or @tech{phase level} 1 within the
+ defined at the relevant @tech{phase level} within the
  exporting module, and that have the same lexical context as the
  @racket[(all-defined-out)] form, excluding bindings to @tech{rename
  transformers} where the target identifier has the
@@ -776,7 +789,7 @@ follows.
 
  @defsubform[(rename-out [orig-id export-id] ...)]{ Exports each
  @racket[orig-id], which must be @tech{bound} within the module at
- @tech{phase level} 0.  The symbolic name for each export is
+ the relevant @tech{phase level}.  The symbolic name for each export is
  @racket[export-id] instead @racket[orig-d].
 
  @defexamples[#:eval (syntax-eval)
@@ -821,8 +834,8 @@ follows.
  @defsubform[(struct-out id)]{Exports the bindings associated with a
  structure type @racket[id]. Typically, @racket[id] is bound with
  @racket[(struct id ....)]; more generally, @racket[id] must have a
- @tech{transformer binding} of structure-type information at
- @tech{phase level} 0; see @secref["structinfo"].  Furthermore, for
+ @tech{transformer binding} of structure-type information at the relevant
+ @tech{phase level}; see @secref["structinfo"].  Furthermore, for
  each identifier mentioned in the structure-type information, the
  enclosing module must define or import one identifier that is
  @racket[free-identifier=?]. If the structure-type information
@@ -877,17 +890,21 @@ follows.
 
  @specsubform[#:literals (for-meta) 
               (for-meta phase-level provide-spec ...)]{ Like the union of the
- @racket[provide-spec]s, but adjusted to apply to @tech{phase level}
- specified by @racket[phase-level] (where @racket[#f] corresponds to the
- @tech{label phase level}). In particular, an @racket[_id] or @racket[rename-out] form as
- a @racket[provide-spec] refers to a binding at @racket[phase-level], an
- @racket[all-defined-out] exports only @racket[phase-level]
- definitions, and an @racket[all-from-out] exports bindings
- imported with a shift by @racket[phase-level].
+ @racket[provide-spec]s, but adjusted to apply to the @tech{phase
+ level} specified by @racket[phase-level] relative to the current
+ phase level (where @racket[#f] corresponds to the @tech{label phase
+ level}). In particular, an @racket[_id] or @racket[rename-out] form
+ as a @racket[provide-spec] refers to a binding at
+ @racket[phase-level] relative to the current level, an
+ @racket[all-defined-out] exports only definitions at
+ @racket[phase-level] relative to the current phase level, and an
+ @racket[all-from-out] exports bindings imported with a shift by
+ @racket[phase-level].
 
  @examples[#:eval (syntax-eval)
    (module nest racket
-     (define-for-syntax eggs 2)
+     (begin-for-syntax
+      (define eggs 2))
      (define chickens 3)
      (provide (for-syntax eggs)
               chickens))
@@ -905,7 +922,8 @@ follows.
               chickens))
 
    (module nest2 racket
-     (define-for-syntax eggs 2)
+     (begin-for-syntax
+      (define eggs 2))
      (provide (for-syntax eggs)))
    (require (for-meta 2 racket/base)
             (for-syntax 'nest2))
@@ -2138,9 +2156,9 @@ a @racket[define-syntaxes] form introduces local bindings.
 Like @racket[define], except that the binding is at @tech{phase level}
 1 instead of @tech{phase level} 0 relative to its context. The
 expression for the binding is also at @tech{phase level} 1. (See
-@secref["id-model"] for information on @tech{phase levels}.)
-Evaluation of @racket[expr] side is @racket[parameterize]d to set
-@racket[current-namespace] as in @racket[let-syntax].
+@secref["id-model"] for information on @tech{phase levels}.)  The form
+is a shorthand for @racket[(begin-for-syntax (define id expr))] or
+@racket[(begin-for-syntax (define (head args) body ...+))].
 
 Within a module, bindings introduced by @racket[define-for-syntax]
 must appear before their uses or in the same
@@ -2275,18 +2293,24 @@ in tail position only if no @racket[body]s are present.
 
 @defform[(begin-for-syntax form ...)]{
 
-Allowed only in a @tech{top-level context} or @tech{module context}.
-Each @racket[form] is partially expanded (see
-@secref["partial-expansion"]) to determine one of the following
-classifications:
+Allowed only in a @tech{top-level context} or @tech{module context},
+shifts the @tech{phase level} of each @racket[form] by one:
 
 @itemize[
 
- @item{@racket[define] or @racket[define-values] form: converted to
-       a @racket[define-values-for-syntax] form.}
+ @item{expressions reference bindings at a @tech{phase level} one
+       greater than in the context of the @racket[begin-for-syntax]
+       form;}
 
- @item{@racket[require] form: content is wrapped with
-       @racket[for-syntax].}
+ @item{@racket[define], @racket[define-values],
+       @racket[define-syntax], and @racket[define-syntaxes] forms bind
+       at a @tech{phase level} one greater than in the context of the
+       @racket[begin-for-syntax] form;}
+
+ @item{in @racket[require] and @racket[provide] forms, the default
+       @tech{phase level} is greater, which is roughly like wrapping
+       the content of the @racket[require] form with
+       @racket[for-syntax];}
 
  @item{expression form @racket[_expr]: converted to
        @racket[(define-values-for-syntax () (begin _expr (values)))], which
@@ -2296,6 +2320,12 @@ classifications:
 
 ]
 
+See also @racket[module] for information about expansion order and
+partial expansion for @racket[begin-for-syntax] within a module
+context. Evaluation of an @racket[expr] within
+@racket[begin-for-syntax] is @racket[parameterize]d to set
+@racket[current-namespace] as in @racket[let-syntax].
+
 }
 
 @;------------------------------------------------------------------------
diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl
index bb4115cb9c..646e6cf992 100644
--- a/collects/scribblings/reference/unsafe.scrbl
+++ b/collects/scribblings/reference/unsafe.scrbl
@@ -209,7 +209,9 @@ at least @racket[(add1 pos)] (for @racket[unsafe-list-ref]) or
 @defproc[(unsafe-set-box*! [v (and/c box? (not/c impersonator?))] [val any/c]) void?]
 )]{
 
-Unsafe versions of @racket[unbox] and @racket[set-box!].}
+Unsafe versions of @racket[unbox] and @racket[set-box!], where the
+@schemeidfont{box*} variants can be faster but do not work on
+@tech{impersonators}.}
 
 
 @deftogether[(
@@ -222,9 +224,11 @@ Unsafe versions of @racket[unbox] and @racket[set-box!].}
 )]{
 
 Unsafe versions of @racket[vector-length], @racket[vector-ref], and
-@racket[vector-set!]. A vector's size can never be larger than a
-@tech{fixnum} (so even @racket[vector-length] always returns a
-fixnum).}
+@racket[vector-set!], where the @schemeidfont{vector*} variants can be
+faster but do not work on @tech{impersonators}.
+
+A vector's size can never be larger than a @tech{fixnum}, so even
+@racket[vector-length] always returns a fixnum.}
 
 
 @deftogether[(
@@ -300,7 +304,9 @@ Unsafe versions of @racket[u16vector-ref] and
 )]{
 
 Unsafe field access and update for an instance of a structure
-type. The index @racket[k] must be between @racket[0] (inclusive) and
+type, where the @schemeidfont{struct*} variants can be
+faster but do not work on @tech{impersonators}.
+The index @racket[k] must be between @racket[0] (inclusive) and
 the number of fields in the struture (exclusive). In the case of
 @racket[unsafe-struct-set!], the field must be mutable.}
 
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
index 23751755a7..5ae3a8d5e9 100644
--- a/collects/scribblings/scribble/manual.scrbl
+++ b/collects/scribblings/scribble/manual.scrbl
@@ -462,6 +462,9 @@ sub-form in a procedure being documented).}
 @racket[racketfont], but colored as meta-syntax, such as backquote or
 unquote.}
 
+@defproc[(racketcommentfont [pre-content pre-content?] ...) element?]{Like
+@racket[racketfont], but colored as a comment.}
+
 @defproc[(racketerror [pre-content pre-content?] ...) element?]{Like
 @racket[racketfont], but colored as error-message text.}
 
diff --git a/collects/scribblings/scribble/renderer.scrbl b/collects/scribblings/scribble/renderer.scrbl
index 2b59580fa2..56dfb2d17b 100644
--- a/collects/scribblings/scribble/renderer.scrbl
+++ b/collects/scribblings/scribble/renderer.scrbl
@@ -15,11 +15,17 @@
      (intro)))
 
 @(begin
-  (define-syntax-rule (def-render-mixin id)
+  (define-syntax-rule (def-html-render-mixin id)
     (begin
       (require (for-label scribble/html-render))
       (define id @racket[render-mixin])))
-  (def-render-mixin html:render-mixin))
+  (def-html-render-mixin html:render-mixin))
+@(begin
+  (define-syntax-rule (def-latex-render-mixin id)
+    (begin
+      (require (for-label scribble/latex-render))
+      (define id @racket[render-mixin])))
+  (def-latex-render-mixin latex:render-mixin))
 
 @title[#:tag "renderer"]{Renderers}
 
@@ -281,3 +287,14 @@ files.}
 @defmixin[render-mixin (render%) ()]{
 
 Specializes a @racket[render%] class for generating Latex input.}}
+
+@; ----------------------------------------
+
+@section{PDF Renderer}
+
+@defmodule/local[scribble/pdf-render]{
+
+@defmixin[render-mixin (render%) ()]{
+
+Specializes a @racket[render%] class for generating PDF output via
+Latex, building on @|latex:render-mixin| from @racketmodname[scribble/latex-render].}}
diff --git a/collects/scriblib/figure.rkt b/collects/scriblib/figure.rkt
index a30dd1c4df..ab81d7d463 100644
--- a/collects/scriblib/figure.rkt
+++ b/collects/scriblib/figure.rkt
@@ -42,27 +42,17 @@
 (define leftfiguremultiwide-style (make-style "LeftfigureMultiWide" figure-style-extras))
 
 (define (figure tag caption #:style [style centerfigure-style] . content)
-  (apply figure-helper style tag caption content))
+  (apply figure-helper figure-style style tag caption content))
+
 (define (figure-here tag caption . content)
-  (apply figure-helper herefigure-style tag caption content))
-(define (figure-helper style tag caption . content)
+  (apply figure-helper herefigure-style centerfigure-style tag caption content))
+
+(define (figure-helper figure-style content-style tag caption . content)
   (make-nested-flow 
    figure-style 
    (list
-    (make-nested-flow
-     style
-     (list
-      (make-nested-flow
-       figureinside-style
-       (append
-        (decode-flow content)
-        (list)))))
-    (make-paragraph 
-     centertext-style 
-     (list
-      (make-element legend-style
-                    (list (Figure-target tag) ": " 
-                          caption)))))))
+     (make-nested-flow content-style (list (make-nested-flow figureinside-style (decode-flow content))))
+     (make-paragraph centertext-style (list (make-element legend-style (list (Figure-target tag) ": " caption)))))))
 
 (define (*figure style tag caption content)
   (make-nested-flow
@@ -75,15 +65,12 @@
       (list
        (make-paragraph
         plain
-        (list
-         (make-element legend-style
-                       (list (Figure-target tag) ": " 
-                             caption))))))))))
+        (list (make-element legend-style (list (Figure-target tag) ": " caption))))))))))
 
-(define (figure* tag caption #:style [style centerfiguremulti-style] . content)
-  (*figure style tag caption content))
-(define (figure** tag caption #:style [style centerfiguremultiwide-style] . content)
-  (*figure style tag caption content))
+(define (figure* tag caption . content)
+  (*figure centerfiguremulti-style tag caption content))
+(define (figure** tag caption . content)
+  (*figure centerfiguremultiwide-style tag caption content))
 
 (define figures (new-counter "figure"))
 (define (Figure-target tag)
diff --git a/collects/scriblib/figure.tex b/collects/scriblib/figure.tex
index 17feceaa8a..4606cd5601 100644
--- a/collects/scriblib/figure.tex
+++ b/collects/scriblib/figure.tex
@@ -9,12 +9,16 @@
 \newlength{\FigOrigskip}
 \FigOrigskip=\parskip
 
+\newenvironment{Figure}{\begin{figure}}{\end{figure}}
+
+\newenvironment{Centerfigure}{\begin{center}}{\end{center}}
+\def\Centertext#1{\begin{center}#1\end{center}}
+
+\newenvironment{Leftfigure}{\begin{flushleft}}{\end{flushleft}}
+
 \newenvironment{CenterfigureMulti}{\begin{figure*}[t!p]\centering}{\end{figure*}}
 \newenvironment{CenterfigureMultiWide}{\begin{CenterfigureMulti}}{\end{CenterfigureMulti}}
-\newenvironment{Centerfigure}{\begin{figure}[t!p]\centering}{\end{figure}}
-\newenvironment{Herefigure}{\begin{figure}[ht!p]\centering}{\end{figure}}
-\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\topsep=0pt\parsep=\FigOrigskip\partopsep=0pt}\item}{\end{list}}
 
-\newenvironment{LeftfigureMulti}{\begin{figure*}[t!p]}{\end{figure*}}
-\newenvironment{LeftfigureMultiWide}{\begin{leftfigureMulti}}{\end{leftfigureMulti}}
-\newenvironment{Leftfigure}{\begin{figure}[t!p]}{\end{figure}}
+\newenvironment{Herefigure}{\begin{figure}[ht!]\centering}{\end{figure}}
+
+\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\topsep=0pt\parsep=\FigOrigskip\partopsep=0pt}\item}{\end{list}}
diff --git a/collects/setup/getinfo.rkt b/collects/setup/getinfo.rkt
index 748a625ee0..7ae7b1c1ca 100644
--- a/collects/setup/getinfo.rkt
+++ b/collects/setup/getinfo.rkt
@@ -1,6 +1,10 @@
 #lang scheme/base
 
-(require scheme/match scheme/contract planet/cachepath syntax/modread)
+(require scheme/match 
+         scheme/contract 
+         planet/cachepath 
+         syntax/modread
+         "path-relativize.rkt")
 
 ;; in addition to infodomain/compiled/cache.rktd, getinfo will look in this 
 ;; file to find mappings. PLaneT uses this to put info about installed
@@ -118,6 +122,12 @@
     (for ([f+root-dir (reverse (table-paths t))])
       (let ([f (car f+root-dir)]
             [root-dir (cdr f+root-dir)])
+        (define-values (path->info-relative
+                        info-relative->path)
+          (make-relativize (lambda () root-dir)
+                           'info
+                           'path->info-relative
+                           'info-relative->path))
         (when (file-exists? f)
           (for ([i (let ([l (with-input-from-file f read)])
                      (cond [(list? l) l]
@@ -125,7 +135,7 @@
                            [else (error 'find-relevant-directories
                                         "bad info-domain cache file: ~a" f)]))])
             (match i
-              [(list (? bytes? pathbytes)
+              [(list (and pathbytes (or (? bytes?) (list 'info (? bytes?) ...)))
                      (list (? symbol? fields) ...)
                      key ;; anything is okay here
                      (? integer? maj)
@@ -134,10 +144,14 @@
                      [new-item
                       (make-directory-record
                        maj min key
-                       (let ([p (bytes->path pathbytes)])
-                         (if (and (relative-path? p) root-dir)
-                           (build-path root-dir p)
-                            p))
+                       (if (bytes? pathbytes)
+                           (let ([p (bytes->path pathbytes)])
+                             (if (and (relative-path? p) root-dir)
+                                 ;; `raco setup' doesn't generate relative paths anyway,
+                                 ;; but it's ok to support them:
+                                 (build-path root-dir p)
+                                 p))
+                           (info-relative->path pathbytes))
                        fields)])
                  (hash-set! colls key
                             ((table-insert t) new-item old-items)))]
diff --git a/collects/setup/parallel-build.rkt b/collects/setup/parallel-build.rkt
index 32927d7851..bee2989ef5 100644
--- a/collects/setup/parallel-build.rkt
+++ b/collects/setup/parallel-build.rkt
@@ -49,7 +49,8 @@
 
 (define (->bytes x)
   (cond [(path? x) (path->bytes x)]
-        [(string? x) (string->bytes/locale x)]))
+        [(string? x) (string->bytes/locale x)]
+        [(equal? x 'relative) (->bytes (path->complete-path (current-directory)))]))
 
 (define collects-queue% 
   (class* object% (work-queue<%>) 
diff --git a/collects/setup/path-relativize.rkt b/collects/setup/path-relativize.rkt
index 90ed58c550..22402be0d4 100644
--- a/collects/setup/path-relativize.rkt
+++ b/collects/setup/path-relativize.rkt
@@ -20,8 +20,7 @@
   ;; tree, so we explode the paths. This is slower than the old way
   ;; (by a factor of 2 or so), but it's simpler and more portable.
   (define (explode-path path)
-    (let loop ([path (simplify-path
-                      (normal-case-path (path->complete-path path)))]
+    (let loop ([path (simplify-path (path->complete-path path))]
                [rest null])
       (let-values ([(base name dir?) (split-path path)])
         (if (path? base)
diff --git a/collects/setup/scribble.rkt b/collects/setup/scribble.rkt
index 3ca3bb241d..cc76f5be36 100644
--- a/collects/setup/scribble.rkt
+++ b/collects/setup/scribble.rkt
@@ -48,16 +48,16 @@
 
 (define (filter-user-docs docs make-user?)
   (cond ;; Specifically disabled user stuff, filter
-        [(not make-user?) (filter main-doc? docs)]
-        ;; If we've built user-specific before, keep building
-        [(file-exists? (build-path (find-user-doc-dir) "index.html")) docs]
-        ;; Otherwise, see if we need it:
-        [(ormap (lambda (doc)
-                  (not (or (doc-under-main? doc)
-                           (memq 'no-depend-on (doc-flags doc)))))
-                docs)
-         docs]
-        [else (filter main-doc? docs)])) ; Don't need them, so drop them
+   [(not make-user?) (filter main-doc? docs)]
+   ;; If we've built user-specific before, keep building
+   [(file-exists? (build-path (find-user-doc-dir) "index.html")) docs]
+   ;; Otherwise, see if we need it:
+   [(ormap (lambda (doc)
+             (not (or (doc-under-main? doc)
+                      (memq 'no-depend-on (doc-flags doc)))))
+           docs)
+    docs]
+   [else (filter main-doc? docs)])) ; Don't need them, so drop them
 
 (define (parallel-do-error-handler setup-printf doc errmsg outstr errstr)
   (setup-printf "error running" (module-path-prefix->string (doc-src-spec doc)))
@@ -69,13 +69,13 @@
          only-dirs          ; limits doc builds
          latex-dest         ; if not #f, generate Latex output
          auto-start-doc?    ; if #t, expands `only-dir' with [user-]start to
-                            ;  catch new docs
+                                        ;  catch new docs
          make-user?         ; are we making user stuff?
          with-record-error  ; catch & record exceptions
          setup-printf)
   (define (scribblings-flag? sym)
     (memq sym '(main-doc main-doc-root user-doc-root user-doc multi-page
-                depends-all depends-all-main no-depend-on always-run)))
+                         depends-all depends-all-main no-depend-on always-run)))
   (define (validate-scribblings-infos infos)
     (define (validate path [flags '()] [cat '(library)] [name #f])
       (and (string? path) (relative-path? path)
@@ -99,32 +99,32 @@
     (let ([s (validate-scribblings-infos (i 'scribblings))]
           [dir (directory-record-path rec)])
       (if s
-        (map (lambda (d)
-               (let* ([flags (cadr d)]
-                      [under-main?
-                       (and (not (memq 'main-doc-root flags))
-                            (not (memq 'user-doc-root flags))
-                            (not (memq 'user-doc flags))
-                            (or (memq 'main-doc flags)
-                                (hash-ref main-dirs dir #f)
-                                (pair? (path->main-collects-relative dir))))])
-                 (make-doc dir
-                           (let ([spec (directory-record-spec rec)])
-                             (list* (car spec)
-                                    (car d)
-                                    (if (eq? 'planet (car spec))
-                                        (list (append (cdr spec)
-                                                      (list (directory-record-maj rec)
-                                                            (list '= (directory-record-min rec)))))
-                                        (cdr spec))))
-                           (simplify-path (build-path dir (car d)) #f)
-                           (doc-path dir (cadddr d) flags under-main?)
-                           flags under-main? (caddr d))))
-             s)
-        (begin (setup-printf
-                "WARNING"
-                "bad 'scribblings info: ~e from: ~e" (i 'scribblings) dir)
-               null))))
+          (map (lambda (d)
+                 (let* ([flags (cadr d)]
+                        [under-main?
+                         (and (not (memq 'main-doc-root flags))
+                              (not (memq 'user-doc-root flags))
+                              (not (memq 'user-doc flags))
+                              (or (memq 'main-doc flags)
+                                  (hash-ref main-dirs dir #f)
+                                  (pair? (path->main-collects-relative dir))))])
+                   (make-doc dir
+                             (let ([spec (directory-record-spec rec)])
+                               (list* (car spec)
+                                      (car d)
+                                      (if (eq? 'planet (car spec))
+                                          (list (append (cdr spec)
+                                                        (list (directory-record-maj rec)
+                                                              (list '= (directory-record-min rec)))))
+                                          (cdr spec))))
+                             (simplify-path (build-path dir (car d)) #f)
+                             (doc-path dir (cadddr d) flags under-main?)
+                             flags under-main? (caddr d))))
+               s)
+          (begin (setup-printf
+                  "WARNING"
+                  "bad 'scribblings info: ~e from: ~e" (i 'scribblings) dir)
+                 null))))
   (define docs
     (let* ([recs (find-relevant-directory-records '(scribblings) 'all-available)]
            [main-dirs (parameterize ([current-library-collection-paths
@@ -141,22 +141,22 @@
     (and (ormap can-build*? docs)
          (filter values
                  (if (not (worker-count . > . 1))
-                    (map (get-doc-info only-dirs latex-dest auto-main? auto-user? 
-                                       with-record-error setup-printf #f) 
-                         docs)
-                    (parallel-do 
+                     (map (get-doc-info only-dirs latex-dest auto-main? auto-user? 
+                                        with-record-error setup-printf #f) 
+                          docs)
+                     (parallel-do 
                       worker-count
                       (lambda (workerid)
                         (list workerid program-name (verbose) only-dirs latex-dest auto-main? auto-user?))
                       (list-queue
-                        docs
-                        (lambda (x workerid) (s-exp->fasl (serialize x)))
-                        (lambda (work r outstr errstr) 
-                          (printf "~a" outstr)
-                          (printf "~a" errstr)
-                          (deserialize (fasl->s-exp r)))
-                        (lambda (work errmsg outstr errstr) 
-                          (parallel-do-error-handler setup-printf work errmsg outstr errstr)))
+                       docs
+                       (lambda (x workerid) (s-exp->fasl (serialize x)))
+                       (lambda (work r outstr errstr) 
+                         (printf "~a" outstr)
+                         (printf "~a" errstr)
+                         (deserialize (fasl->s-exp r)))
+                       (lambda (work errmsg outstr errstr) 
+                         (parallel-do-error-handler setup-printf work errmsg outstr errstr)))
                       (define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest 
                                                           auto-main? auto-user?) 
                         (define ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user?) 
@@ -169,8 +169,8 @@
                           (define (with-record-error cc go fail-k)
                             (with-handlers ([exn:fail?
                                              (lambda (exn)
-                                                   (eprintf "~a\n" (exn-message exn))
-                                                   (raise exn))])
+                                               (eprintf "~a\n" (exn-message exn))
+                                               (raise exn))])
                               (go)))
                           (s-exp->fasl (serialize 
                                         ((get-doc-info only-dirs latex-dest auto-main? auto-user?  
@@ -179,9 +179,9 @@
                         
                         (verbose verbosev)
                         (match-message-loop
-                          [doc (send/success 
-                                ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user?) 
-                                 doc))])))))))
+                         [doc (send/success 
+                               ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user?) 
+                                doc))])))))))
 
   (define (make-loop first? iter)
     (let ([ht (make-hash)]
@@ -310,12 +310,12 @@
         (let ([need-rerun (filter-map (lambda (i) 
                                         (and (info-need-run? i)
                                              (begin
-                                                (when (info-need-in-write? i) 
-                                                  (write-in/info latex-dest i)
-                                                  (set-info-need-in-write?! i #f))
-                                                (set-info-deps! i (filter info? (info-deps i)))
-                                                (set-info-need-run?! i #f)
-                                                i)))
+                                               (when (info-need-in-write? i) 
+                                                 (write-in/info latex-dest i)
+                                                 (set-info-need-in-write?! i #f))
+                                               (set-info-deps! i (filter info? (info-deps i)))
+                                               (set-info-need-run?! i #f)
+                                               i)))
                                       infos)])
           (define (say-rendering i workerid)
             (setup-printf (string-append
@@ -327,46 +327,46 @@
             (match response 
               [#f (set-info-failed?! info #t)]
               [(list in-delta? out-delta? defs undef)
-                (set-info-rendered?! info #t)
-                (set-info-provides! info defs)
-                (set-info-undef! info undef)
-                (when out-delta?
-                  (set-info-out-time! info (/ (current-inexact-milliseconds) 1000)))
-                (when in-delta? 
-                  ;; Reset expected dependencies to known dependencies, and recompute later:
-                  (set-info-deps! info (info-known-deps info))
-                  (set-info-need-in-write?! info #t))
-                (set-info-time! info (/ (current-inexact-milliseconds) 1000))]))
-            (if (not (worker-count . > . 1))
+               (set-info-rendered?! info #t)
+               (set-info-provides! info defs)
+               (set-info-undef! info undef)
+               (when out-delta?
+                 (set-info-out-time! info (/ (current-inexact-milliseconds) 1000)))
+               (when in-delta? 
+                 ;; Reset expected dependencies to known dependencies, and recompute later:
+                 (set-info-deps! info (info-known-deps info))
+                 (set-info-need-in-write?! info #t))
+               (set-info-time! info (/ (current-inexact-milliseconds) 1000))]))
+          (if (not (worker-count . > . 1))
               (map (lambda (i) 
-                    (say-rendering i #f)
-                    (update-info i (build-again! latex-dest i with-record-error))) need-rerun)
+                     (say-rendering i #f)
+                     (update-info i (build-again! latex-dest i with-record-error))) need-rerun)
               (parallel-do 
-                worker-count
-                (lambda (workerid) (list workerid (verbose) latex-dest))
-                (list-queue
-                  need-rerun
-                  (lambda (i workerid) 
-                    (say-rendering i workerid)
-                    (s-exp->fasl (serialize (info-doc i))))
-                  (lambda (i r outstr errstr) 
-                    (printf "~a" outstr) 
-                    (printf "~a" errstr)
-                    (update-info i (deserialize (fasl->s-exp r))))
-                  (lambda (i errmsg outstr errstr) 
-                    (parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr)))
-                (define-worker (build-again!-worker2 workerid verbosev latex-dest)
-                  (define (with-record-error cc go fail-k)
-                    (with-handlers ([exn:fail?
-                                     (lambda (x)
-                                           (eprintf "~a\n" (exn-message x))
-                                           (raise x))])
-                      (go)))
-                  (verbose verbosev)
-                  (match-message-loop
-                    [info 
-                     (send/success 
-                      (s-exp->fasl (serialize (build-again! latex-dest (deserialize (fasl->s-exp info)) with-record-error))))])))))
+               worker-count
+               (lambda (workerid) (list workerid (verbose) latex-dest))
+               (list-queue
+                need-rerun
+                (lambda (i workerid) 
+                  (say-rendering i workerid)
+                  (s-exp->fasl (serialize (info-doc i))))
+                (lambda (i r outstr errstr) 
+                  (printf "~a" outstr) 
+                  (printf "~a" errstr)
+                  (update-info i (deserialize (fasl->s-exp r))))
+                (lambda (i errmsg outstr errstr) 
+                  (parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr)))
+               (define-worker (build-again!-worker2 workerid verbosev latex-dest)
+                 (define (with-record-error cc go fail-k)
+                   (with-handlers ([exn:fail?
+                                    (lambda (x)
+                                      (eprintf "~a\n" (exn-message x))
+                                      (raise x))])
+                     (go)))
+                 (verbose verbosev)
+                 (match-message-loop
+                  [info 
+                   (send/success 
+                    (s-exp->fasl (serialize (build-again! latex-dest (deserialize (fasl->s-exp info)) with-record-error))))])))))
         ;; If we only build 1, then it reaches it own fixpoint
         ;; even if the info doesn't seem to converge immediately.
         ;; This is a useful shortcut when re-building a single
@@ -383,44 +383,44 @@
 
 (define (make-renderer latex-dest doc)
   (if latex-dest
-    (new (latex:render-mixin render%)
-         [dest-dir latex-dest]
-         ;; Use PLT manual style:
-         [prefix-file (collection-file-path "manual-prefix.tex" "scribble")]
-         [style-file (collection-file-path "manual-style.tex" "scribble")]
-         ;; All .tex files go to the same directory, so prefix
-         ;; generated/copied file names to keep them separate:
-         [helper-file-prefix (let-values ([(base name dir?) (split-path
-                                                             (doc-dest-dir doc))])
-                               (path-element->string name))])
-    (let* ([flags (doc-flags doc)]
-           [multi? (memq 'multi-page flags)]
-           [main?  (doc-under-main? doc)]
-           [ddir   (doc-dest-dir doc)]
-           [root?  (or (memq 'main-doc-root flags)
-                       (memq 'user-doc-root flags))])
-      (new ((if multi? html:render-multi-mixin values)
-            (html:render-mixin render%))
-        [dest-dir (if multi?
-                    (let-values ([(base name dir?) (split-path ddir)]) base)
-                    ddir)]
-        [alt-paths   (if main?
-                         (let ([std-path (lambda (s)
-                                           (cons (collection-file-path s "scribble")
-                                                 (format "../~a" s)))])
-                           (list (std-path "scribble.css")
-                                 (std-path "scribble-style.css")
-                                 (std-path "racket.css")
-                                 (std-path "scribble-common.js")))
-                         null)]
-        ;; For main-directory, non-start files, up-path is #t, which makes the
-        ;; "up" link go to the (user's) start page using cookies. For other files,
-        ;; 
-        [up-path     (and (not root?)
-                          (if main?
-                              #t
-                              (build-path (find-user-doc-dir) "index.html")))]
-        [search-box? #t]))))
+      (new (latex:render-mixin render%)
+           [dest-dir latex-dest]
+           ;; Use PLT manual style:
+           [prefix-file (collection-file-path "manual-prefix.tex" "scribble")]
+           [style-file (collection-file-path "manual-style.tex" "scribble")]
+           ;; All .tex files go to the same directory, so prefix
+           ;; generated/copied file names to keep them separate:
+           [helper-file-prefix (let-values ([(base name dir?) (split-path
+                                                               (doc-dest-dir doc))])
+                                 (path-element->string name))])
+      (let* ([flags (doc-flags doc)]
+             [multi? (memq 'multi-page flags)]
+             [main?  (doc-under-main? doc)]
+             [ddir   (doc-dest-dir doc)]
+             [root?  (or (memq 'main-doc-root flags)
+                         (memq 'user-doc-root flags))])
+        (new ((if multi? html:render-multi-mixin values)
+              (html:render-mixin render%))
+             [dest-dir (if multi?
+                           (let-values ([(base name dir?) (split-path ddir)]) base)
+                           ddir)]
+             [alt-paths   (if main?
+                              (let ([std-path (lambda (s)
+                                                (cons (collection-file-path s "scribble")
+                                                      (format "../~a" s)))])
+                                (list (std-path "scribble.css")
+                                      (std-path "scribble-style.css")
+                                      (std-path "racket.css")
+                                      (std-path "scribble-common.js")))
+                              null)]
+             ;; For main-directory, non-start files, up-path is #t, which makes the
+             ;; "up" link go to the (user's) start page using cookies. For other files,
+             ;; 
+             [up-path     (and (not root?)
+                               (if main?
+                                   #t
+                                   (build-path (find-user-doc-dir) "index.html")))]
+             [search-box? #t]))))
 
 (define (pick-dest latex-dest doc)
   (cond [latex-dest
@@ -457,8 +457,8 @@
                p))
       (let ([tag-prefix p]
             [tags (if (member '(part "top") (part-tags v))
-                    (part-tags v)
-                    (cons '(part "top") (part-tags v)))]
+                      (part-tags v)
+                      (cons '(part "top") (part-tags v)))]
             [style (part-style v)])
         (make-part
          tag-prefix
@@ -478,8 +478,8 @@
          (part-blocks v)
          (part-parts v)))))
   (ensure-doc-prefix
-    (dynamic-require-doc (doc-src-spec doc))
-    (doc-src-spec doc)))
+   (dynamic-require-doc (doc-src-spec doc))
+   (doc-src-spec doc)))
 
 (define (omit? cat)
   (or (eq? cat 'omit)
@@ -573,116 +573,116 @@
        (path->relative-string/setup (doc-src-file doc))))
 
     (if up-to-date?
-      ;; Load previously calculated info:
-      (render-time
-       "use"
-       (with-handlers ([exn:fail? (lambda (exn)
-                                    (log-error (format "get-doc-info error: ~a"
-                                                       (exn-message exn)))
-                                    (delete-file info-out-file)
-                                    (delete-file info-in-file)
-                                    ((get-doc-info only-dirs latex-dest auto-main?
-                                                   auto-user? with-record-error
-                                                   setup-printf workerid)
-                                     doc))])
-         (let* ([v-in  (load-sxref info-in-file)]
-                [v-out (load-sxref info-out-file)])
-           (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
-                        (equal? (car v-out) (list vers (doc-flags doc))))
-             (error "old info has wrong version or flags"))
-           (make-info
-            doc
-            (let ([v (list-ref v-out 2)]) ; provides
-              (with-my-namespace
-               (lambda ()
-                 (deserialize v))))
-            (let ([v (list-ref v-in 1)])  ; undef
-              (with-my-namespace
-               (lambda ()
-                 (deserialize v))))
-            (let ([v (list-ref v-in 3)])  ; searches
-              (with-my-namespace
-               (lambda ()
-                 (deserialize v))))
-            (map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build...
-            null ; known deps (none at this point)
-            can-run?
-            my-time info-out-time
-            (and can-run? (memq 'always-run (doc-flags doc)))
-            #f 
-            #f
-            vers
-            #f
-            #f))))
-      (if can-run?
-        ;; Run the doc once:
-        (with-record-error
-         (doc-src-file doc)
-         (lambda ()
-           (parameterize ([current-directory (doc-src-dir doc)])
-             (let* ([v (load-doc/ensure-prefix doc)]
-                    [dest-dir (pick-dest latex-dest doc)]
-                    [fp (send renderer traverse (list v) (list dest-dir))]
-                    [ci (send renderer collect (list v) (list dest-dir) fp)]
-                    [ri (send renderer resolve (list v) (list dest-dir) ci)]
-                    [out-v (and info-out-time
-                                (info-out-time . >= . src-time)
-                                (with-handlers ([exn:fail? (lambda (exn) #f)])
-                                  (let ([v (load-sxref info-out-file)])
-                                    (unless (equal? (car v) (list vers (doc-flags doc)))
-                                      (error "old info has wrong version or flags"))
-                                    v)))]
-                    [sci (send renderer serialize-info ri)]
-                    [defs (send renderer get-defined ci)]
-                    [undef (send renderer get-external ri)]
-                    [searches (resolve-info-searches ri)]
-                    [need-out-write?
-                     (or (not out-v)
-                         (not (equal? (list vers (doc-flags doc))
-                                      (car out-v)))
-                         (not (serialized=? sci (cadr out-v)))
-                         (not (equal? (any-order defs) (any-order (deserialize (caddr out-v)))))
-                         (info-out-time . > . (current-seconds)))])
-               (when (and (verbose) need-out-write?)
-                 (fprintf (current-error-port) " [New out ~a]\n" (doc-src-file doc)))
-               (gc-point)
-               (let ([info
-                      (make-info doc
-                                 defs     ; provides
-                                 undef
-                                 searches
-                                 null ; no deps, yet
-                                 null ; no known deps, yet
-                                 can-run?
-                                 -inf.0
-                                 (if need-out-write?
-                                     (/ (current-inexact-milliseconds) 1000)
-                                     info-out-time)
-                                 #t
-                                 can-run?
-                                 need-out-write?
-                                 vers
-                                 #f
-                                 #f)])
-                 (when need-out-write?
-                   (render-time "xref-out" (write-out/info latex-dest info sci))
-                   (set-info-need-out-write?! info #f))
-                 (when (info-need-in-write? info)
-                     (render-time "xref-in" (write-in/info latex-dest info))
-                   (set-info-need-in-write?! info #f))
+        ;; Load previously calculated info:
+        (render-time
+         "use"
+         (with-handlers ([exn:fail? (lambda (exn)
+                                      (log-error (format "get-doc-info error: ~a"
+                                                         (exn-message exn)))
+                                      (delete-file info-out-file)
+                                      (delete-file info-in-file)
+                                      ((get-doc-info only-dirs latex-dest auto-main?
+                                                     auto-user? with-record-error
+                                                     setup-printf workerid)
+                                       doc))])
+           (let* ([v-in  (load-sxref info-in-file)]
+                  [v-out (load-sxref info-out-file)])
+             (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
+                          (equal? (car v-out) (list vers (doc-flags doc))))
+               (error "old info has wrong version or flags"))
+             (make-info
+              doc
+              (let ([v (list-ref v-out 2)]) ; provides
+                (with-my-namespace
+                 (lambda ()
+                   (deserialize v))))
+              (let ([v (list-ref v-in 1)])  ; undef
+                (with-my-namespace
+                 (lambda ()
+                   (deserialize v))))
+              (let ([v (list-ref v-in 3)])  ; searches
+                (with-my-namespace
+                 (lambda ()
+                   (deserialize v))))
+              (map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build...
+              null ; known deps (none at this point)
+              can-run?
+              my-time info-out-time
+              (and can-run? (memq 'always-run (doc-flags doc)))
+              #f 
+              #f
+              vers
+              #f
+              #f))))
+        (if can-run?
+            ;; Run the doc once:
+            (with-record-error
+             (doc-src-file doc)
+             (lambda ()
+               (parameterize ([current-directory (doc-src-dir doc)])
+                 (let* ([v (load-doc/ensure-prefix doc)]
+                        [dest-dir (pick-dest latex-dest doc)]
+                        [fp (send renderer traverse (list v) (list dest-dir))]
+                        [ci (send renderer collect (list v) (list dest-dir) fp)]
+                        [ri (send renderer resolve (list v) (list dest-dir) ci)]
+                        [out-v (and info-out-time
+                                    (info-out-time . >= . src-time)
+                                    (with-handlers ([exn:fail? (lambda (exn) #f)])
+                                      (let ([v (load-sxref info-out-file)])
+                                        (unless (equal? (car v) (list vers (doc-flags doc)))
+                                          (error "old info has wrong version or flags"))
+                                        v)))]
+                        [sci (send renderer serialize-info ri)]
+                        [defs (send renderer get-defined ci)]
+                        [undef (send renderer get-external ri)]
+                        [searches (resolve-info-searches ri)]
+                        [need-out-write?
+                         (or (not out-v)
+                             (not (equal? (list vers (doc-flags doc))
+                                          (car out-v)))
+                             (not (serialized=? sci (cadr out-v)))
+                             (not (equal? (any-order defs) (any-order (deserialize (caddr out-v)))))
+                             (info-out-time . > . (current-seconds)))])
+                   (when (and (verbose) need-out-write?)
+                     (fprintf (current-error-port) " [New out ~a]\n" (doc-src-file doc)))
+                   (gc-point)
+                   (let ([info
+                          (make-info doc
+                                     defs     ; provides
+                                     undef
+                                     searches
+                                     null ; no deps, yet
+                                     null ; no known deps, yet
+                                     can-run?
+                                     -inf.0
+                                     (if need-out-write?
+                                         (/ (current-inexact-milliseconds) 1000)
+                                         info-out-time)
+                                     #t
+                                     can-run?
+                                     need-out-write?
+                                     vers
+                                     #f
+                                     #f)])
+                     (when need-out-write?
+                       (render-time "xref-out" (write-out/info latex-dest info sci))
+                       (set-info-need-out-write?! info #f))
+                     (when (info-need-in-write? info)
+                       (render-time "xref-in" (write-in/info latex-dest info))
+                       (set-info-need-in-write?! info #f))
 
-                 (when (or (stamp-time . < . aux-time)
-                           (stamp-time . < . src-time))
-                   (let ([data (list (get-compiled-file-sha1 src-zo)
-                                     (get-compiled-file-sha1 renderer-path)
-                                     (get-file-sha1 css-path))])
-                     (with-compile-output stamp-file (lambda (out tmp-filename) (write data out)))
-                     (let ([m (max aux-time src-time)])
-                       (unless (equal? m +inf.0)
-                         (file-or-directory-modify-seconds stamp-file m)))))
-                 info))))
-         (lambda () #f))
-        #f))))
+                     (when (or (stamp-time . < . aux-time)
+                               (stamp-time . < . src-time))
+                       (let ([data (list (get-compiled-file-sha1 src-zo)
+                                         (get-compiled-file-sha1 renderer-path)
+                                         (get-file-sha1 css-path))])
+                         (with-compile-output stamp-file (lambda (out tmp-filename) (write data out)))
+                         (let ([m (max aux-time src-time)])
+                           (unless (equal? m +inf.0)
+                             (file-or-directory-modify-seconds stamp-file m)))))
+                     info))))
+             (lambda () #f))
+            #f))))
 
 (define (make-prod-thread)
   ;; periodically dumps a stack trace, which can give us some idea of
@@ -701,62 +701,69 @@
   expr
   #;
   (begin
-    (printf "For ~a\n" what)
-    (time expr))
+  (printf "For ~a\n" what)
+  (time expr))
   #;
   (begin
-    (collect-garbage) (collect-garbage) (printf "pre: ~a ~s\n" what (current-memory-use))
-    (begin0
-     (time expr)
-     (collect-garbage) (collect-garbage) (printf "post ~a ~s\n" what (current-memory-use)))))
+  (collect-garbage) (collect-garbage) (printf "pre: ~a ~s\n" what (current-memory-use))
+  (begin0
+  (time expr)
+  (collect-garbage) (collect-garbage) (printf "post ~a ~s\n" what (current-memory-use)))))
 
 (define (load-sxrefs latex-dest doc vers)
   (match (list (load-sxref (sxref-path latex-dest doc "in.sxref")) (load-sxref (sxref-path latex-dest doc "out.sxref")))
     [(list (list in-version undef deps-rel searches dep-docs) (list out-version sci provides))
-      (unless (and (equal? in-version  (list vers (doc-flags doc)))
-                   (equal? out-version (list vers (doc-flags doc))))
-        (error "old info has wrong version or flags"))
-      (with-my-namespace*
-        (values (deserialize undef) deps-rel (deserialize searches) (deserialize dep-docs) sci (deserialize provides)))]))
+     (unless (and (equal? in-version  (list vers (doc-flags doc)))
+                  (equal? out-version (list vers (doc-flags doc))))
+       (error "old info has wrong version or flags"))
+     (with-my-namespace*
+      (values (deserialize undef) 
+              deps-rel
+              (deserialize searches)
+              (map rel-doc->doc (deserialize dep-docs))
+              sci
+              (deserialize provides)))]))
 
 (define (build-again! latex-dest info with-record-error)
   (define (cleanup-dest-dir doc)
     (unless latex-dest
       (let ([dir (doc-dest-dir doc)])
         (if (not (directory-exists? dir))
-          (make-directory*/ignore-exists-exn dir)
-          (for ([f (directory-list dir)]
-                #:when
-                (and (file-exists? f)
-                     (not (regexp-match? #"[.]sxref$"
-                                         (path-element->bytes f)))))
-             (delete-file (build-path dir f)))))))
+            (make-directory*/ignore-exists-exn dir)
+            (for ([f (directory-list dir)]
+                  #:when
+                  (and (file-exists? f)
+                       (not (regexp-match? #"[.]sxref$"
+                                           (path-element->bytes f)))))
+              (delete-file (build-path dir f)))))))
   (define (load-doc-sci doc)
     (cadr (load-sxref (sxref-path latex-dest doc "out.sxref"))))
   (define doc (if (info? info ) (info-doc info) info))
   (define renderer (make-renderer latex-dest doc))
   (with-record-error
-    (doc-src-file doc)
-    (lambda ()
-      (define vers (send renderer get-serialize-version))
-      (define-values (ff-undef ff-deps-rel ff-searches ff-dep-docs ff-sci ff-provides)
-        (if (info? info)
-          (values (info-undef info) 
-                  (info-deps->rel-doc-src-file info)
-                  (info-searches info)
-                  (info-deps->doc info)
-                  (load-doc-sci doc)
-                  (info-provides info))
-          (load-sxrefs latex-dest doc vers)))
-        
-      (parameterize ([current-directory (doc-src-dir doc)])
-        (let* ([v (render-time "load" (load-doc/ensure-prefix doc))]
+   (doc-src-file doc)
+   (lambda ()
+     (define vers (send renderer get-serialize-version))
+     (define-values (ff-undef ff-deps-rel ff-searches ff-dep-docs ff-sci ff-provides)
+       (if (info? info)
+           (values (info-undef info) 
+                   (info-deps->rel-doc-src-file info)
+                   (info-searches info)
+                   (info-deps->doc info)
+                   (load-doc-sci doc)
+                   (info-provides info))
+           (load-sxrefs latex-dest doc vers)))
+     
+     (parameterize ([current-directory (doc-src-dir doc)])
+       (let* ([v (render-time "load" (load-doc/ensure-prefix doc))]
               [dest-dir (pick-dest latex-dest doc)]
               [fp (render-time "traverse" (send renderer traverse (list v) (list dest-dir)))]
               [ci (render-time "collect" (send renderer collect (list v) (list dest-dir) fp))]
               [ri (begin 
-                    (render-time "deserialize" (with-my-namespace* (for ([dep-doc ff-dep-docs]) 
-                      (send renderer deserialize-info (load-doc-sci dep-doc) ci))))
+                    (render-time "deserialize" 
+                                 (with-my-namespace* 
+                                  (for ([dep-doc ff-dep-docs]) 
+                                    (send renderer deserialize-info (load-doc-sci dep-doc) ci))))
                     (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci)))]
               [sci (render-time "serialize" (send renderer serialize-info ri))]
               [defs (render-time "defined" (send renderer get-defined ci))]
@@ -764,28 +771,28 @@
               [in-delta? (not (equal? (any-order undef) (any-order ff-undef)))]
               [out-delta? (or (not (serialized=? sci ff-sci))
                               (not (equal? (any-order defs) (any-order ff-provides))))])
-          (when (verbose)
-            (printf " [~a~afor ~a]\n"
-                    (if in-delta? "New in " "")
-                    (cond [out-delta? "New out "]
-                          [in-delta? ""]
-                          [else "No change "])
-                    (doc-src-file doc)))
+         (when (verbose)
+           (printf " [~a~afor ~a]\n"
+                   (if in-delta? "New in " "")
+                   (cond [out-delta? "New out "]
+                         [in-delta? ""]
+                         [else "No change "])
+                   (doc-src-file doc)))
 
-          (when in-delta?
-              (render-time "xref-in" (write-in latex-dest vers doc undef ff-deps-rel ff-searches ff-dep-docs)))
-          (when out-delta?
-              (render-time "xref-out" (write-out latex-dest vers doc sci defs)))
+         (when in-delta?
+           (render-time "xref-in" (write-in latex-dest vers doc undef ff-deps-rel ff-searches ff-dep-docs)))
+         (when out-delta?
+           (render-time "xref-out" (write-out latex-dest vers doc sci defs)))
 
-          (cleanup-dest-dir doc)
-          (render-time
-            "render"
-            (with-record-error
-             (doc-src-file doc)
-             (lambda () (send renderer render (list v) (list dest-dir) ri))
-             void))
-          (gc-point)
-          (list in-delta? out-delta? defs undef))))
+         (cleanup-dest-dir doc)
+         (render-time
+          "render"
+          (with-record-error
+           (doc-src-file doc)
+           (lambda () (send renderer render (list v) (list dest-dir) ri))
+           void))
+         (gc-point)
+         (list in-delta? out-delta? defs undef))))
    (lambda () #f)))
 
 (define (gc-point)
@@ -825,8 +832,8 @@
     (when (verbose) (printf " [Caching to disk ~a]\n" filename))
     (make-directory*/ignore-exists-exn (doc-dest-dir doc))
     (with-compile-output filename 
-      (lambda (out tmp-filename)
-        (write-bytes (s-exp->fasl (append (list (list vers (doc-flags doc))) data)) out)))))
+                         (lambda (out tmp-filename)
+                           (write-bytes (s-exp->fasl (append (list (list vers (doc-flags doc))) data)) out)))))
 
 (define (write-out latex-dest vers doc sci provides)
   (write- latex-dest vers doc "out.sxref" 
@@ -835,13 +842,20 @@
 
 (define (write-out/info latex-dest info sci)
   (write-out latex-dest (info-vers info) (info-doc info) sci (info-provides info)))
-    
+
 (define (write-in latex-dest vers doc undef rels searches dep-docs)
   (write- latex-dest vers doc "in.sxref" 
-               (list (serialize undef)
-                     rels
-                     (serialize searches)
-                     (serialize dep-docs))))
+          (list (serialize undef)
+                rels
+                (serialize searches)
+                ;; The following last element is used only by the parallel build.
+                ;; It's redundant in the sense that the same information
+                ;; is in `rels' --- the docs that this one depends on ---
+                ;; but putting the whole `doc' record here makes it easier
+                ;; for a place to reconstruct a suitable `doc' record.
+                ;; It probably would be better to reconstruct the `doc'
+                ;; record in a place from the path.
+                (serialize (map doc->rel-doc dep-docs)))))
 
 (define (write-in/info latex-dest info)
   (write-in latex-dest
@@ -863,6 +877,20 @@
         (path->bytes r)
         r)))
 
+(define (doc->rel-doc d)
+  (struct-copy doc 
+               d
+               [src-dir (path->main-collects-relative (doc-src-dir d))]
+               [src-file (path->main-collects-relative (doc-src-file d))]
+               [dest-dir (path->main-doc-relative (doc-dest-dir d))]))
+
+(define (rel-doc->doc d)
+  (struct-copy doc 
+               d
+               [src-dir (main-collects-relative->path (doc-src-dir d))]
+               [src-file (main-collects-relative->path (doc-src-file d))]
+               [dest-dir (main-doc-relative->path (doc-dest-dir d))]))
+
 (define (info-deps->rel-doc-src-file info)
   (filter-map (lambda (i) (and (info? i) 
                                (path->rel (doc-src-file (info-doc i))))) 
diff --git a/collects/setup/setup-unit.rkt b/collects/setup/setup-unit.rkt
index 39003f9f4f..4a5cefbb42 100644
--- a/collects/setup/setup-unit.rkt
+++ b/collects/setup/setup-unit.rkt
@@ -26,6 +26,7 @@
          "dirs.rkt"
          "main-collects.rkt"
          "path-to-relative.rkt"
+         "path-relativize.rkt"
          "private/omitted-paths.rkt"
          "parallel-build.rkt"
          "collects.rkt"
@@ -655,7 +656,7 @@
              [dir-table (make-hash)]
              [doing-path (lambda (path)
                            (unless (verbose)
-                             (let ([path (normal-case-path (path-only path))])
+                             (let ([path (path-only path)])
                                (unless (hash-ref dir-table path #f)
                                  (hash-set! dir-table path #t)
                                  (print-verbose oop path)))))])
@@ -792,8 +793,23 @@
     ;; about those collections that exist in the same root as the ones in
     ;; `collections-to-compile'.
     (let ([ht (make-hash)]
-          [ht-orig (make-hash)])
+          [ht-orig (make-hash)]
+          [roots (make-hash)])
       (for ([cc ccs-to-compile])
+        (define-values (path->info-relative info-relative->path)
+          (apply values
+                 (hash-ref roots 
+                           (cc-info-root cc)
+                           (lambda ()
+                             (define-values (p-> ->p)
+                               (if (cc-info-root cc)
+                                   (make-relativize (lambda () (cc-info-root cc))
+                                                    'info
+                                                    'path->info-relative
+                                                    'info-relative->path)
+                                   (values #f #f)))
+                             (hash-set! roots (cc-info-root cc) (list p-> ->p))
+                             (list p-> ->p)))))
         (let* ([domain (with-handlers ([exn:fail? (lambda (x) (lambda () null))])
                          (dynamic-require
                           (build-path (cc-path cc) "info.rkt")
@@ -817,13 +833,16 @@
                             (set! all-ok? #t)
                             (for ([i l])
                               (match i
-                                [(list (? bytes? a) (list (? symbol? b) ...) c (? integer? d) (? integer? e))
-                                 (let ([p (bytes->path a)])
+                                [(list (and a (or (? bytes?) (list 'info (? bytes?) ...)))
+                                       (list (? symbol? b) ...) c (? integer? d) (? integer? e))
+                                 (let ([p (if (bytes? a)
+                                              (bytes->path a)
+                                              a)])
                                    ;; Check that the path is suitably absolute or relative:
                                    (let ([dir (case (cc-info-path-mode cc)
                                                 [(relative abs-in-relative)
-                                                 (or (and (relative-path? p)
-                                                          (build-path (cc-info-root cc) p))
+                                                 (or (and (list? p)
+                                                          (info-relative->path p))
                                                      (and (complete-path? p)
                                                           ;; `c' must be `(lib ...)'
                                                           (list? c) 
@@ -839,11 +858,25 @@
                                                  (and (complete-path? p)
                                                       p)])])
                                      (if (and dir
+                                              (let ([omit-root
+                                                      (if (path? p)
+                                                          ;; absolute path => need a root for checking omits;
+                                                          ;; for a collection path of length N, go up N-1 dirs:
+                                                          (simplify-path (apply build-path p (for/list ([i (cddr c)]) 'up)) #f)
+                                                          ;; relative path => no root needed for checking omits:
+                                                          #f)])
+                                                (not (eq? 'all (omitted-paths dir getinfo omit-root))))
                                               (or (file-exists? (build-path dir "info.rkt"))
                                                   (file-exists? (build-path dir "info.ss"))))
                                          (hash-set! t a (list b c d e))
-                                         (set! all-ok? #f))))]
-                                [_ (set! all-ok? #f)])))
+                                         (begin
+                                           (when (verbose)
+                                             (printf " drop entry: ~s\n" i))
+                                           (set! all-ok? #f)))))]
+                                [_ 
+                                 (when (verbose)
+                                   (printf " bad entry: ~s\n" i))
+                                 (set! all-ok? #f)])))
                           ;; Record the table loaded for this collection root
                           ;; in the all-roots table:
                           (hash-set! ht (cc-info-path cc) t)
@@ -854,14 +887,18 @@
                                      (and all-ok? (hash-copy t)))
                           t))))])
           ;; Add this collection's info to the table, replacing any information
-          ;; already there.
-          (hash-set! t
-                     (path->bytes (if (eq? (cc-info-path-mode cc) 'relative)
-                                      ;; Use relative path:
-                                      (apply build-path (cc-collection cc))
-                                      ;; Use absolute path:
-                                      (cc-path cc)))
-                     (cons (domain) (cc-shadowing-policy cc)))))
+          ;; already there, if the collection has an "info.ss" file:
+          (when (or (file-exists? (build-path (cc-path cc) "info.rkt"))
+                    (file-exists? (build-path (cc-path cc) "info.ss")))
+            (hash-set! t
+                       (if (eq? (cc-info-path-mode cc) 'relative)
+                           ;; Use relative path:
+                           (path->info-relative (apply build-path 
+                                                       (cc-info-root cc)
+                                                       (cc-collection cc)))
+                           ;; Use absolute path:
+                           (path->bytes (cc-path cc)))
+                       (cons (domain) (cc-shadowing-policy cc))))))
       ;; Write out each collection-root-specific table to a "cache.rktd" file:
       (hash-for-each ht
         (lambda (info-path ht)
@@ -870,6 +907,16 @@
             (make-directory* base)
             (let ([p info-path])
               (setup-printf "updating" "~a" (path->relative-string/setup p))
+              (when (verbose)
+                (let ([ht0 (hash-ref ht-orig info-path)])
+                  (when ht0
+                    (for ([(k v) (in-hash ht)])
+                      (let ([v2 (hash-ref ht0 k #f)])
+                        (unless (equal? v v2)
+                          (printf " ~s -> ~s\n   instead of ~s\n" k v v2))))
+                    (for ([(k v) (in-hash ht0)])
+                      (unless (hash-ref ht k #f)
+                        (printf " ~s removed\n" k))))))
               (with-handlers ([exn:fail? (warning-handler (void))])
                 (with-output-to-file p
                   #:exists 'truncate/replace
diff --git a/collects/srfi/11.rkt b/collects/srfi/11.rkt
index 2762552933..fdb915219f 100644
--- a/collects/srfi/11.rkt
+++ b/collects/srfi/11.rkt
@@ -1,3 +1,72 @@
-;; Supported by core PLT:
-#lang scheme/base
+;; The versions from `racket/base' don't support rest args.
+
+#|
+
+Modified to use `syntax-parse' and multiple macros by Sam
+Tobin-Hochstadt, 2011.
+
+The original:
+
+Copyright (C) Lars T Hansen (1999). All Rights Reserved.
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without restriction,
+including without limitation the rights to use, copy, modify, merge,
+publish, distribute, sublicense, and/or sell copies of the Software,
+and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+|#
+
+#lang racket/base
+(require (for-syntax racket/base syntax/parse))
+
+(define-syntax let-values
+  (syntax-parser
+    ((let-values (?binding ...) ?body0 ?body1 ...)
+     #'(let-values/bind (?binding ...) () (begin ?body0 ?body1 ...)))))
+
+(define-syntax let-values/bind
+  (syntax-parser
+    ((let-values/bind () ?tmps ?body)
+     #'(let ?tmps ?body))
+    ((let-values/bind ((?b0 ?e0) ?binding ...) ?tmps ?body)
+     #'(let-values/mktmp ?b0 ?e0 () (?binding ...) ?tmps ?body))))
+
+(define-syntax let-values/mktmp
+  (syntax-parser
+    ((let-values/mktmp () ?e0 ?args ?bindings ?tmps ?body)
+     #'(call-with-values
+           (lambda () ?e0)
+         (lambda ?args
+           (let-values/bind ?bindings ?tmps ?body))))
+
+    ((let-values/mktmp (?a . ?b) ?e0 (?arg ...) ?bindings (?tmp ...) ?body)
+     #'(let-values/mktmp ?b ?e0 (?arg ... x) ?bindings (?tmp ... (?a x)) ?body))
+
+    ((let-values/mktmp ?a ?e0 (?arg ...) ?bindings (?tmp ...) ?body)
+     #'(call-with-values (lambda () ?e0)
+         (lambda (?arg ... . x)
+           (let-values/bind ?bindings (?tmp ... (?a x)) ?body))))))
+
+(define-syntax let*-values
+  (syntax-parser
+    ((let*-values () ?body0 ?body1 ...)
+     #'(begin ?body0 ?body1 ...))
+
+    ((let*-values (?binding0 ?binding1 ...) ?body0 ?body1 ...)
+     #'(let-values (?binding0)
+         (let*-values (?binding1 ...) ?body0 ?body1 ...)))))
+
 (provide let-values let*-values)
diff --git a/collects/string-constants/private/english-string-constants.rkt b/collects/string-constants/private/english-string-constants.rkt
index bb287fff8e..d4de794ca1 100644
--- a/collects/string-constants/private/english-string-constants.rkt
+++ b/collects/string-constants/private/english-string-constants.rkt
@@ -113,9 +113,10 @@ please adhere to these guidelines:
  (untitled-n "Untitled ~a")
  (warning "Warning")
  (error "Error")
- (close "Close") ;; as in, close an open window. must match close-menu-item
+ (close "Close") ;; as in, close an open window or tab. must match close-menu-item
                  ;; in the sense that, when the &s have been stripped from
                  ;; close-menu-item, it must be the same string as this.
+ (close-window "Close Window")
  (stop "Stop")   
  (&stop "&Stop") ;; for use in button and menu item labels, with short cut.
  (are-you-sure-delete? "Are you sure you want to delete ~a?") ;; ~a is a filename or directory name
@@ -477,6 +478,7 @@ please adhere to these guidelines:
  (show-interactions-on-execute "Automatically open interactions window when running a program")
  (switch-to-module-language-automatically "Automatically switch to the module language when opening a module")
  (interactions-beside-definitions "Put the interactions window beside the definitions window") ;; in preferences, below the checkbox one line above this one
+ (old-style-keybindings "Old-style keybindings (Run: <menukey>-t; New-tab: <menukey>-=; Replace: <menukey>-r)")
  (show-line-numbers "Show line numbers")
  (show-line-numbers/menu "Show Line &Numbers")  ;; just like the above, but capitalized for appearance in a menu item
  (hide-line-numbers/menu "Hide Line &Numbers")
@@ -674,6 +676,7 @@ please adhere to these guidelines:
 
  (close-info "Close this file")
  (close-menu-item "&Close")
+ (close-window-menu-item "&Close Window")
 
  (quit-info "Close all windows")
  (quit-menu-item-windows "E&xit")
@@ -1371,7 +1374,7 @@ please adhere to these guidelines:
   ;; title of this section of the dialog (possibly the word
   ;; `Collection' should not be translated)
   (ml-cp-collection-paths "Collection Paths")
-
+  
   ;; button labels
   (ml-cp-add "Add")
   (ml-cp-add-default "Add Default")
diff --git a/collects/string-constants/private/german-string-constants.rkt b/collects/string-constants/private/german-string-constants.rkt
index 237dbdadcc..b99e6e74cf 100644
--- a/collects/string-constants/private/german-string-constants.rkt
+++ b/collects/string-constants/private/german-string-constants.rkt
@@ -23,7 +23,10 @@
  (untitled-n "Namenlos ~a")
  (warning "Warnung")
  (error "Fehler")
- (close "Schließen") ;; as in, close an open window
+ (close "Schließen") ;; as in, close an open window or tab. must match close-menu-item
+                  ;; in the sense that, when the &s have been stripped from
+                  ;; close-menu-item, it must be the same string as this.
+ (close-window "Fenster schließen")
  (stop "Stop")
  (&stop "&Stop") ;; for use in button and menu item labels, with short cut.
  (are-you-sure-delete? "Sind Sie sicher, dass Sie ~a löschen wollen?") ;; ~a is a filename or directory name
@@ -573,6 +576,7 @@
 
  (close-info "Diese Datei schließen")
  (close-menu-item "&Schließen")
+ (close-window-menu-item "Fenster &schließen")
 
  (quit-info "Alle Fenster schließen")
  (quit-menu-item-windows "Be&enden")
diff --git a/collects/syntax/kerncase.rkt b/collects/syntax/kerncase.rkt
index a561fd9ba4..6a8f44cd62 100644
--- a/collects/syntax/kerncase.rkt
+++ b/collects/syntax/kerncase.rkt
@@ -21,7 +21,7 @@
                                             begin begin0 set!
                                             with-continuation-mark
                                             if #%plain-app #%expression
-                                            define-values define-syntaxes define-values-for-syntax
+                                            define-values define-syntaxes begin-for-syntax
                                             module 
                                             #%plain-module-begin 
                                             #%require #%provide 
@@ -78,7 +78,7 @@
                 begin0
                 define-values
                 define-syntaxes
-                define-values-for-syntax
+                begin-for-syntax
                 set!
                 let-values
                 letrec-values
diff --git a/collects/syntax/parse/private/parse.rkt b/collects/syntax/parse/private/parse.rkt
index 10eef457e2..0634de5a07 100644
--- a/collects/syntax/parse/private/parse.rkt
+++ b/collects/syntax/parse/private/parse.rkt
@@ -8,6 +8,7 @@
                      "rep.rkt"
                      "kws.rkt"
                      "txlift.rkt")
+         racket/syntax
          racket/stxparam
          syntax/stx
          unstable/struct
@@ -242,9 +243,10 @@ Conventions:
                    [es null]
                    [cx x]
                    [fh0 (syntax-patterns-fail ctx0)])
-              (with ([fail-handler fh0]
-                     [cut-prompt fh0])
-                (try alternative ...)))))))]))
+              (parameterize ((current-syntax-context ctx0))
+                (with ([fail-handler fh0]
+                       [cut-prompt fh0])
+                  (try alternative ...))))))))]))
 
 ;; ----
 
diff --git a/collects/syntax/parse/private/rep.rkt b/collects/syntax/parse/private/rep.rkt
index 69f3417c50..c0af86edb1 100644
--- a/collects/syntax/parse/private/rep.rkt
+++ b/collects/syntax/parse/private/rep.rkt
@@ -2,8 +2,7 @@
 (require (for-template racket/base
                        racket/stxparam
                        "keywords.rkt"
-                       "runtime.rkt"
-                       (only-in unstable/syntax phase-of-enclosing-module))
+                       "runtime.rkt")
          racket/contract/base
          "minimatch.rkt"
          syntax/id-table
@@ -1301,10 +1300,7 @@ A syntax class is integrable if
 ;; check-literal-entry : stx stx -> (list id id ct-phase ct-phase)
 (define (check-literal-entry stx ctx)
   (define (go internal external phase)
-    (txlift #`(check-literal (quote-syntax #,external)
-                             #,phase
-                             (phase-of-enclosing-module)
-                             (quote-syntax #,ctx)))
+    (txlift #`(check-literal #,external #,phase #,ctx))
     (list internal external phase phase))
   (syntax-case stx ()
     [(internal external #:phase phase)
diff --git a/collects/syntax/parse/private/runtime.rkt b/collects/syntax/parse/private/runtime.rkt
index d8beb8e6f0..a71919d0e0 100644
--- a/collects/syntax/parse/private/runtime.rkt
+++ b/collects/syntax/parse/private/runtime.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/list
          racket/stxparam
+         unstable/syntax
          "runtime-progress.rkt"
          "runtime-failure.rkt"
          (for-syntax racket/base
@@ -257,15 +258,33 @@
 (provide check-literal
          free-identifier=?/phases)
 
-;; check-literal : id phase-level phase-level stx -> void
-;; FIXME: change to normal 'error', if src gets stripped away
-(define (check-literal id abs-phase mod-phase ctx)
-  (unless (identifier-binding id abs-phase)
+;; (check-literal id phase-level-expr ctx) -> void
+(define-syntax (check-literal stx)
+  (syntax-case stx ()
+    [(check-literal id used-phase-expr ctx)
+     (let* ([ok-phases/ct-rel
+             ;; id is bound at each of ok-phases/ct-rel
+             ;; (phase relative to the compilation of the module in which the
+             ;; 'syntax-parse' (or related) form occurs)
+             (filter (lambda (p) (identifier-binding #'id p)) '(0 1 -1 #f))])
+       ;; so we can avoid run-time call to identifier-binding if
+       ;;   (+ (phase-of-enclosing-module) ok-phase/ct-rel) = used-phase
+       (with-syntax ([ok-phases/ct-rel ok-phases/ct-rel])
+         #'(check-literal* (quote-syntax id)
+                           used-phase-expr
+                           (phase-of-enclosing-module)
+                           'ok-phases/ct-rel
+                           (quote-syntax ctx))))]))
+
+(define (check-literal* id used-phase mod-phase ok-phases/ct-rel ctx)
+  (unless (or (memv (and used-phase (- used-phase mod-phase))
+                    ok-phases/ct-rel)
+              (identifier-binding id used-phase))
     (raise-syntax-error
      #f
      (format "literal is unbound in phase ~a (phase ~a relative to the enclosing module)"
-             abs-phase
-             (and abs-phase (- abs-phase mod-phase)))
+             used-phase
+             (and used-phase (- used-phase mod-phase)))
      ctx id)))
 
 ;; free-identifier=?/phases : id phase-level id phase-level -> boolean
@@ -273,23 +292,27 @@
 ;; that y has at phase-level y.
 ;; At least one of the identifiers MUST have a binding (module or lexical)
 (define (free-identifier=?/phases x phase-x y phase-y)
-  (let ([bx (identifier-binding x phase-x)]
-        [by (identifier-binding y phase-y)])
-    (cond [(and (list? bx) (list? by))
-           (let ([modx (module-path-index-resolve (first bx))]
-                 [namex (second bx)]
-                 [phasex (fifth bx)]
-                 [mody (module-path-index-resolve (first by))]
-                 [namey (second by)]
-                 [phasey (fifth by)])
-             (and (eq? modx mody) ;; resolved-module-paths are interned
-                  (eq? namex namey)
-                  (equal? phasex phasey)))]
-          [else
-           ;; Module is only way to get phase-shift; if not module-bound names,
-           ;; then only identifiers at same phase can refer to same binding.
-           (and (equal? phase-x phase-y)
-                (free-identifier=? x y phase-x))])))
+  (cond [(eqv? phase-x phase-y)
+         (free-identifier=? x y phase-x)]
+        [else
+         (let ([bx (identifier-binding x phase-x)]
+               [by (identifier-binding y phase-y)])
+           (cond [(and (pair? bx) (pair? by))
+                  (let ([mpix (first bx)]
+                        [namex (second bx)]
+                        [defphasex (fifth bx)]
+                        [mpiy (first by)]
+                        [namey (second by)]
+                        [defphasey (fifth by)])
+                    (and (eq? namex namey)
+                         ;; resolved-module-paths are interned
+                         (eq? (module-path-index-resolve mpix)
+                              (module-path-index-resolve mpiy))
+                         (eqv? defphasex defphasey)))]
+                 [else
+                  ;; Module is only way to get phase-shift; phases differ, so
+                  ;; if not module-bound names, no way can refer to same binding.
+                  #f]))]))
 
 ;; ----
 
diff --git a/collects/syntax/parse/private/sc.rkt b/collects/syntax/parse/private/sc.rkt
index 00bd0332e3..e60d83d712 100644
--- a/collects/syntax/parse/private/sc.rkt
+++ b/collects/syntax/parse/private/sc.rkt
@@ -4,6 +4,7 @@
                      racket/syntax
                      "rep-data.rkt"
                      "rep.rkt")
+         racket/syntax
          "parse.rkt"
          "keywords.rkt"
          "runtime.rkt"
@@ -163,14 +164,15 @@
                        [(def ...) defs]
                        [expr expr])
            #'(defattrs/unpack (a ...)
-               (let* ([x expr]
+               (let* ([x (datum->syntax #f expr)]
                       [cx x]
                       [pr (ps-empty x x)]
                       [es null]
                       [fh0 (syntax-patterns-fail x)])
-                 def ...
-                 (#%expression
-                  (with ([fail-handler fh0]
-                         [cut-prompt fh0])
-                    (parse:S x cx pattern pr es
-                             (list (attribute name) ...)))))))))]))
+                 (parameterize ((current-syntax-context x))
+                   def ...
+                   (#%expression
+                    (with ([fail-handler fh0]
+                           [cut-prompt fh0])
+                          (parse:S x cx pattern pr es
+                                   (list (attribute name) ...))))))))))]))
diff --git a/collects/syntax/scribblings/parse/parsing.scrbl b/collects/syntax/scribblings/parse/parsing.scrbl
index 5972197acb..6ba87ee86e 100644
--- a/collects/syntax/scribblings/parse/parsing.scrbl
+++ b/collects/syntax/scribblings/parse/parsing.scrbl
@@ -3,7 +3,8 @@
           scribble/struct
           scribble/decode
           scribble/eval
-          "parse-common.rkt")
+          "parse-common.rkt"
+          (for-label racket/syntax))
 
 @title{Parsing Syntax}
 
@@ -58,7 +59,9 @@ The following options are supported:
              #:contracts ([context-expr syntax?])]{
 
 When present, @racket[context-expr] is used in reporting parse
-failures; otherwise @racket[stx-expr] is used.
+failures; otherwise @racket[stx-expr] is used. The
+@racket[current-syntax-context] parameter is also set to the value of
+@racket[context-expr].
 
 @(myexamples
   (syntax-parse #'(a b 3)
diff --git a/collects/syntax/scribblings/struct.scrbl b/collects/syntax/scribblings/struct.scrbl
index c31ccd9ebc..9483cc5158 100644
--- a/collects/syntax/scribblings/struct.scrbl
+++ b/collects/syntax/scribblings/struct.scrbl
@@ -56,8 +56,8 @@ source location to the generated identifiers.}
                                   [omit-set? boolean?]
 
                                   [super-type any/c #f]
-                                  [prop-value-list list? empty]
-                                  [immutable-k-list list? empty])
+                                  [prop-value-list list? '(list)]
+                                  [immutable-k-list list? '(list)])
          (listof identifier?)]{
 
 Takes the same arguments as @racket[build-struct-names] and generates
@@ -65,7 +65,7 @@ an S-expression for code using @racket[make-struct-type] to generate
 the structure type and return values for the identifiers created by
 @racket[build-struct-names].  The optional @racket[super-type],
 @racket[prop-value-list], and @racket[immutable-k-list] parameters take
-S-expression values that are used as the corresponding arguments to
+S-expressions that are used as the corresponding argument expressions to
 @racket[make-struct-type].}
 
 
@@ -76,8 +76,8 @@ S-expression values that are used as the corresponding arguments to
 				   [omit-sel? boolean?]
 				   [omit-set? boolean?]
 				   [super-type any/c #f]
-				   [prop-value-list list? empty]
-				   [immutable-k-list list? empty])
+				   [prop-value-list list? '(list)]
+				   [immutable-k-list list? '(list)])
 	 (listof identifier?)]{
 
 Like @racket[build-struct-generation], but given the names produced by
diff --git a/collects/syntax/struct.rkt b/collects/syntax/struct.rkt
index b6778d6d34..2be275a84c 100644
--- a/collects/syntax/struct.rkt
+++ b/collects/syntax/struct.rkt
@@ -121,17 +121,17 @@
 		     (loop (cdr l))))))))))
 
   (define build-struct-generation
-    (lambda (name-stx fields omit-sel? omit-set? [super-type #f] [prop-value-list null]
-                      [immutable-positions null] [mk-rec-prop-list (lambda (struct: make- ? acc mut) null)]
+    (lambda (name-stx fields omit-sel? omit-set? [super-type #f] [prop-value-list '(list)]
+                      [immutable-positions '(list)]
                       #:constructor-name [ctr-name #f])
       (let ([names (build-struct-names name-stx fields omit-sel? omit-set?
                                        #:constructor-name ctr-name)])
 	(build-struct-generation* names name-stx fields omit-sel? omit-set? super-type prop-value-list
-				  immutable-positions mk-rec-prop-list))))
+				  immutable-positions))))
 
   (define build-struct-generation*
-    (lambda (names name fields omit-sel? omit-set? [super-type #f] [prop-value-list null]
-                   [immutable-positions null] [mk-rec-prop-list (lambda (struct: make- ? acc mut) null)])
+    (lambda (names name fields omit-sel? omit-set? [super-type #f] [prop-value-list '(list)]
+                   [immutable-positions '(list)])
       (let ([num-fields (length fields)]
 	    [acc/mut-makers (let loop ([l fields][n 0])
 			      (if (null? l)
@@ -151,8 +151,7 @@
 				     (if omit-set?
 					 null
 					 (mk-one #f))
-				     (loop (cdr l) (add1 n))))))]
-	    [extra-props (mk-rec-prop-list 'struct: 'make- '? 'acc 'mut)])
+				     (loop (cdr l) (add1 n))))))])
 	`(let-values ([(struct: make- ? acc mut)
 		       (make-struct-type ',name ,super-type ,num-fields 0 #f 
 					 ,prop-value-list (current-inspector)
diff --git a/collects/syntax/toplevel.rkt b/collects/syntax/toplevel.rkt
index dd278e6e41..7602e52dfe 100644
--- a/collects/syntax/toplevel.rkt
+++ b/collects/syntax/toplevel.rkt
@@ -68,7 +68,7 @@
          (eval/compile stx)]
         [(define-syntaxes . _)
          (eval/compile stx)]
-        [(define-values-for-syntax . _)
+        [(begin-for-syntax . _)
          (eval/compile stx)]
         [(define-values (id ...) . _)
 	 (begin0
diff --git a/collects/teachpack/2htdp/scribblings/batch-io.scrbl b/collects/teachpack/2htdp/scribblings/batch-io.scrbl
index 1afb0b4717..c007cc6186 100644
--- a/collects/teachpack/2htdp/scribblings/batch-io.scrbl
+++ b/collects/teachpack/2htdp/scribblings/batch-io.scrbl
@@ -45,6 +45,9 @@
 The batch-io teachpack introduces several functions and a form for reading
  content from files and one function for writing to a file.
 
+@; -----------------------------------------------------------------------------
+@section{IO Functions}
+
 All functions that read a file consume the name of a file and possibly
  additional arguments. They assume that the specified file exists in the
  same folder as the program; if not they signal an error:
@@ -148,6 +151,17 @@ There is only one writer function at the moment:
    (with-handlers ([exn:fail:filesystem? void])
      (delete-file "output.txt")))
 
+@bold{Warning}: The file IO functions in this teachpack are platform
+ dependent. That is, as long as your programs and your files live on the
+ same platform, you should not have any problems reading the files that
+ programs wrote and vice versa. If, however, one of your programs writes a
+ file on a Windows operating system and if you then copy this output file
+ to a Mac, reading the copied text file may produce extraneous ``return''
+ characters. Note that this describes only one example of possible
+ malfunction; there are other cases when trans-platform actions may cause
+ this teachpack to fail. 
+
+@; -----------------------------------------------------------------------------
 @section{Testing}
 
 @defform[(simulate-file process str ...)]{
diff --git a/collects/test-engine/test-engine.scrbl b/collects/test-engine/test-engine.scrbl
index fb4f9eca5b..ca7dacfd71 100644
--- a/collects/test-engine/test-engine.scrbl
+++ b/collects/test-engine/test-engine.scrbl
@@ -24,40 +24,37 @@ and reported by the test function.  Note that the check forms only
 register checks to be performed.  The checks are actually run by the
 @racket[test] function.
 
-@defproc[(check-expect (test any/c) (expected any/c)) void?]{
+@defform[(check-expect (test any/c) (expected any/c))]{
+Checks whether the value of the @racket[test] expression is structurally
+equal to the value produced by the @racket[expected] expression.
 
-Accepts two value-producing expressions and structurally compares the
-resulting values.
+It is an error for @racket[test] or @racket[expected] to produce a function
+value or an inexact number.} 
 
-It is an error to produce a function value or an inexact number.}
+@defform[(check-within (test any/c) (expected any/c) (delta number?))]{
+Checks whether the value of the @racket[test] expression is structurally
+equal to the value produced by the @racket[expected] expression; every
+number in the first expression must be within @racket[delta] of the
+corresponding number in the second expression.
 
+It is an error for @racket[test] or @racket[expected] to produce a function
+value.} 
 
-@defproc[(check-within (test any/c) (expected any/c) (delta number?)) void?]{
-
-Like @racket[check-expect], but with an extra expression that produces
-a number delta. Every number in the first expression must be within
-delta of the cooresponding number in the second expression.
-
-It is an error to produce a function value.}
-
-
-@defproc*[([(check-error (test any/c) (msg string?)) void?]
-           [(check-error (test any/c)) void?])]{
-
-Checks that evaluating the first expression signals an error, where
-the error message matches the string, if it is present.}
+@defform*[ [(check-error (test any/c))
+            (check-error (test any/c) (msg string?))] ]{
+Checks that evaluating @racket[test] signals an error, where
+the error message matches the string (if any).}
 
 @defform[(check-member-of (test any/c) (expected any/c) ...)]{
+Checks whether the value of the @racket[test] expression is structurally
+equal to any of the values produced by the @racket[expected] expressions.
 
-Accepts at least two value-producing expressions. Structurally compares the first
-value to each value subsequent value specified.
-
-It is an error to produce a function value.}
+It is an error for @racket[test] or any of the @racket[expected] expression
+to produce a function value or an inexact number.}
 
 @defform[(check-range (test number/c) (min number/c) (max number/c))]{
-
-Accepts three number-producing expressions. Performs the following comparison:
-min <= test <= max.}
+Checks whether value of @racket[test] is between the values of the
+@racket[min] and @racket[max] expressions [inclusive].}
 
 @defproc[(test) void?]{
 
diff --git a/collects/tests/compiler/zo.rkt b/collects/tests/compiler/zo.rkt
new file mode 100644
index 0000000000..84b3bd6951
--- /dev/null
+++ b/collects/tests/compiler/zo.rkt
@@ -0,0 +1,40 @@
+#lang racket/base
+(require racket/pretty
+         compiler/zo-parse
+         compiler/zo-marshal
+         compiler/decompile)
+
+(define ex-mod1
+  '(module m racket
+     (begin-for-syntax
+      (define fs 10)
+      (list fs))
+     (define-syntax (m stx)
+       #'10)
+     (m)
+     (begin-for-syntax
+      (list fs))))
+
+(define ex-mod2
+  '(module m racket
+     (define t 8)
+     (define s 10)
+     (provide t (protect-out s))))
+
+(define (check ex-mod)
+  (let ([c (parameterize ([current-namespace (make-base-namespace)])
+             (compile ex-mod))])
+    (let ([o (open-output-bytes)])
+      (write c o)
+      (let ([p (zo-parse (open-input-bytes (get-output-bytes o)))])
+        (let ([b (zo-marshal p)])
+          (let ([p2 (zo-parse (open-input-bytes b))]
+                [to-string (lambda (p)
+                             (let ([o (open-output-bytes)])
+                               (print p o)
+                               (get-output-string o)))])
+            (unless (equal? (to-string p) (to-string p2))
+              (error 'zo "failed on example: ~e" ex-mod))))))))
+
+(check ex-mod1)
+(check ex-mod2)
diff --git a/collects/tests/db/all-tests.rkt b/collects/tests/db/all-tests.rkt
index cd6bdc5f8d..99cdd3055a 100644
--- a/collects/tests/db/all-tests.rkt
+++ b/collects/tests/db/all-tests.rkt
@@ -13,7 +13,8 @@
                                 "db/sql-types.rkt"
                                 "db/concurrent.rkt"))
          (prefix-in gen-
-                    "gen/sql-types.rkt"))
+                    (combine-in "gen/sql-types.rkt"
+                                "gen/query.rkt")))
 (provide (all-defined-out))
 
 #|
@@ -21,6 +22,18 @@
 RUNNING THE TESTS
 -----------------
 
+1) Default test configuration.
+
+To run the default tests (ie, the generic tests and sqlite3 tests),
+simply execute this file with no arguments:
+
+  racket -l tests/db/all-tests
+
+This is how DrDr runs the file---we assume the machine running DrDr
+has sqlite installed.
+
+2) Custom test configuration.
+
 First, set up the testing environment as described in the following
 subsections.
 
@@ -101,6 +114,9 @@ Testing profiles are flattened, not hierarchical.
 
 ;; ----
 
+;; Set below by command-line parsing
+(define kill-safe? #f)
+
 (define (dbconf->unit x)
   (match x
     [(dbconf dbtestname (and r (data-source connector _args exts)))
@@ -114,6 +130,20 @@ Testing profiles are flattened, not hierarchical.
   (dbconf->unit
    (dbconf dbtestname (data-source 'odbc dbargs `((db:test ,dbflags))))))
 
+(define sqlite-unit
+  (dbconf->unit
+   (dbconf "sqlite3, memory"
+           (data-source 'sqlite3
+                        '(#:database memory)
+                        '((db:test (issl)))))))
+
+(define sqlite/p-unit
+  (dbconf->unit
+   (dbconf "sqlite3, memory, with #:use-place=#t"
+           (data-source 'sqlite3
+                        '(#:database memory #:use-place #t)
+                        '((db:test (issl async)))))))
+
 ;; ----
 
 (define-unit db-test@
@@ -155,9 +185,16 @@ Testing profiles are flattened, not hierarchical.
 (define (odbc-test dsn [flags null])
   (specialize-test (odbc-unit dsn flags `(#:dsn ,dsn))))
 
-(define generic-tests
+(define sqlite-test
+  (specialize-test sqlite-unit))
+
+(define sqlite/p-test
+  (specialize-test sqlite/p-unit))
+
+(define generic-test
   (make-test-suite "Generic tests (no db)"
-    (list gen-sql-types:test)))
+    (list gen-sql-types:test
+          gen-query:test)))
 
 ;; ----
 
@@ -177,6 +214,7 @@ Testing profiles are flattened, not hierarchical.
 
 (define gui? #f)
 (define include-generic? #f)
+(define include-sqlite? #f)
 
 ;; If no labels given, run generic tests. If labels given, run generic
 ;; tests only if -g option given.
@@ -184,29 +222,33 @@ Testing profiles are flattened, not hierarchical.
 (command-line
  #:once-each
  [("--gui") "Run tests in RackUnit GUI" (set! gui? #t)]
+ [("-k" "--killsafe") "Wrap with kill-safe-connection" (set! kill-safe? #t)]
  [("-g" "--generic") "Run generic tests" (set! include-generic? #t)]
+ [("-s" "--sqlite3") "Run sqlite3 in-memory db tests" (set! include-sqlite? #t)]
  [("-f" "--config-file") file  "Use configuration file" (pref-file file)]
  #:args labels
- (cond [gui?
-        (let* ([dbtests
-                (for/list ([label labels])
-                  (make-all-tests label (get-dbconf (string->symbol label))))]
-               [tests
-                (cond [(or include-generic? (null? dbtests))
-                       (cons generic-tests dbtests)]
-                      [else dbtests])]
-               [test/gui (dynamic-require 'rackunit/gui 'test/gui)])
-          (apply test/gui tests)
-          (eprintf "Press Cntl-C to end.\n") ;; HACK!
-          (with-handlers ([exn:break? (lambda _ (newline) (exit))])
-            (sync never-evt)))]
-       [else
-        (when (or include-generic? (null? labels))
-          (printf "Running generic tests\n")
-          (run-tests generic-tests)
-          (newline))
-        (for ([label labels])
-          (printf "Running ~s tests\n" label)
-          (run-tests
-           (make-all-tests label (get-dbconf (string->symbol label))))
-          (newline))]))
+ (let* ([tests
+         (for/list ([label labels])
+           (cons label
+                 (make-all-tests label (get-dbconf (string->symbol label)))))]
+        [tests
+         (cond [(or include-sqlite? (null? labels))
+                (list* (cons "sqlite3, memory" sqlite-test)
+                       (cons "sqlite3, memory, #:use-place=#t" sqlite/p-test)
+                       tests)]
+               [else tests])]
+        [tests
+         (cond [(or include-generic? (null? labels))
+                (cons (cons "generic" generic-test) tests)]
+               [else tests])])
+   (cond [gui?
+          (let* ([test/gui (dynamic-require 'rackunit/gui 'test/gui)])
+            (apply test/gui (map cdr tests))
+            (eprintf "Press Cntl-C to end.\n") ;; HACK!
+            (with-handlers ([exn:break? (lambda _ (newline) (exit))])
+              (sync never-evt)))]
+         [else
+          (for ([test tests])
+            (printf "Running ~s tests\n" (car test))
+            (time (run-tests (cdr test)))
+            (newline))])))
diff --git a/collects/tests/db/config.rkt b/collects/tests/db/config.rkt
index 53730b70ee..da69cbc88d 100644
--- a/collects/tests/db/config.rkt
+++ b/collects/tests/db/config.rkt
@@ -11,7 +11,8 @@
   (dbtestname
    connect
    dbsys
-   dbflags))
+   dbflags
+   kill-safe?))
 
 (define-signature test^ (test))
 (define-signature config^
@@ -26,6 +27,7 @@
    set-equal?
    sql
    select-val
+   dbsystem
    NOISY?
    TESTFLAGS
    ANYFLAGS))
@@ -37,7 +39,8 @@
   (define NOISY? #f)
 
   (define (connect-for-test)
-    (connect))
+    (cond [kill-safe? (kill-safe-connection (connect))]
+          [else (connect)]))
 
   (define test-data
     '((0 "nothing")
@@ -86,6 +89,14 @@
            (sql (string-append "values (" str ")"))]
           [else (sql (string-append "select " str))]))
 
+  (define dbsystem
+    (with-handlers ([(lambda (e) #t)
+                     (lambda (e) #f)])
+      (let* ([c (connect)]
+             [dbsystem (send c get-dbsystem)])
+        (disconnect c)
+        dbsystem)))
+
   ;; Flags = dbflags U dbsys
 
   ;; Returns #t if all are set.
diff --git a/collects/tests/db/db/concurrent.rkt b/collects/tests/db/db/concurrent.rkt
index ea75f654cb..a051a580c1 100644
--- a/collects/tests/db/db/concurrent.rkt
+++ b/collects/tests/db/db/concurrent.rkt
@@ -7,8 +7,8 @@
 (export test^)
 
 (define (test-concurrency workers)
-  (test-case (format "lots of threads (~s)" workers)
-    (unless (ANYFLAGS 'isora 'isdb2)
+  (unless (ANYFLAGS 'isora 'isdb2)
+    (test-case (format "lots of threads (~s)" workers)
       (call-with-connection
        (lambda (c)
          (query-exec c "create temporary table play_numbers (n integer)")
@@ -40,8 +40,8 @@
             (query-value c "select max(n) from play_numbers"))))
 
 (define (kill-safe-test proxy?)
-  (test-case (format "kill-safe test~a" (if proxy? " (proxy)" ""))
-    (unless (ANYFLAGS 'isora 'isdb2)
+  (unless (ANYFLAGS 'isora 'isdb2)
+    (test-case (format "kill-safe test~a" (if proxy? " (proxy)" ""))
     (call-with-connection
      (lambda (c0)
        (let ([c (if proxy?
@@ -62,50 +62,48 @@
          (for ([t (in-hash-keys threads)])
            (sync t))))))))
 
-;; ----
-
-(define pool-test
-  (test-suite "connection pools"
-    (test-case "lease, limit, release"
-      (let* ([counter 0]
-             [p (connection-pool (lambda () (set! counter (+ 1 counter)) (connect-for-test))
-                                 #:max-connections 2)]
-             [c1 (connection-pool-lease p)]
-             [c2 (connection-pool-lease p)])
-        ;; Two created
-        (check-equal? counter 2)
-        ;; Can't create new one yet
-        (check-exn exn:fail? (lambda () (connection-pool-lease p)))
-        ;; But if we free one...
-        (disconnect c2)
-        (check-equal? (connected? c2) #f)
-        (let ([c3 (connection-pool-lease p)])
-          (check-equal? counter 2 "not new") ;; used idle, not new connection
-          (check-equal? (connected? c3) #t))))
-    (test-case "release on evt"
-      (let* ([p (connection-pool connect-for-test #:max-connections 2)]
-             [sema (make-semaphore 0)]
-             [c1 (connection-pool-lease p sema)])
-        (check-equal? (connected? c1) #t)
-        ;; Closes when evt ready
-        (begin (semaphore-post sema) (sleep 0.1))
-        (check-equal? (connected? c1) #f)))
-    (test-case "release on custodian"
-      (let* ([p (connection-pool connect-for-test #:max-connections 2)]
-             [cust (make-custodian)]
-             [c1 (connection-pool-lease p cust)])
-        (check-equal? (connected? c1) #t)
-        ;; Closes when custodian shutdown
-        (begin (custodian-shutdown-all cust) (sleep 0.1))
-        (check-equal? (connected? c1) #f)))))
+(define (async-test)
+  (unless (ANYFLAGS 'ismy 'isora 'isdb2)
+    (test-case "asynchronous execution"
+      (call-with-connection
+       (lambda (c)
+         (query-exec c "create temporary table nums (n integer)")
+         (for ([i (in-range 40)])
+           (query-exec c (sql "insert into nums (n) values ($1)") i))
+         (let* ([the-sql "select cast(max(a.n * b.n *c.n * d.n) as varchar) \
+                          from nums a, nums b, nums c, nums d"]
+                [pst (prepare c the-sql)]
+                [sema (make-semaphore 0)]
+                [peek (semaphore-peek-evt sema)]
+                [counter 0]
+                [thd
+                 (thread (lambda ()
+                           (let loop ()
+                             (sync peek)
+                             (set! counter (add1 counter))
+                             (sleep 0.01)
+                             (loop))))])
+           (let ([start (current-inexact-milliseconds)])
+             (semaphore-post sema)
+             (query-value c pst)
+             (semaphore-wait sema)
+             (let ([end (current-inexact-milliseconds)])
+               (when (ANYFLAGS 'postgresql 'mysql 'async)
+                 (when #f
+                   (printf "counter = ~s\n" counter)
+                   (printf "time elapsed = ~s\n" (- end start)))
+                 ;; If c does not execute asynchronously, expect counter to be about 0.
+                 (check-pred positive? counter)
+                 (let ([expected-counter (/ (- end start) (* 0.01 1000))])
+                   (check > counter (* 0.5 expected-counter))))))))))))
 
 ;; ----
 
 (define test
   (test-suite "Concurrency"
+    (async-test)
     ;; Tests whether connections are properly locked.
     (test-concurrency 1)
     (test-concurrency 2)
     (test-concurrency 20)
-    (kill-safe-test #t)
-    pool-test))
+    (kill-safe-test #t)))
diff --git a/collects/tests/db/db/connection.rkt b/collects/tests/db/db/connection.rkt
index 2e9c52d5be..77ba036012 100644
--- a/collects/tests/db/db/connection.rkt
+++ b/collects/tests/db/db/connection.rkt
@@ -1,8 +1,10 @@
 #lang racket/unit
 (require (for-syntax racket/base)
+         racket/class
          rackunit
          "../config.rkt"
-         db/base)
+         db/base
+         (only-in db/private/generic/interfaces locking%))
 (import config^ database^)
 (export test^)
 
@@ -30,22 +32,33 @@
            (check-true (dbsystem? sys))
            (check-pred symbol? (dbsystem-name sys))))))
 
-    (test-case "connected?, disconnect work w/ custodian 'damage'"
+    (test-case "connected?, disconnect work w/ custodian damage"
       (let ([c0 (current-custodian)]
             [c1 (make-custodian)])
         (let ([cx (parameterize ((current-custodian c1))
                     (connect-for-test))])
-          ;; cx's ports (if applicable) are controlled by c1
+          ;; cx's ports (if applicable) are managed by c1
           (check-true (connected? cx))
           (custodian-shutdown-all c1)
           (check-completes (lambda () (connected? cx)) "connected?")
           (when (memq dbsys '(mysql postgresql))
+            ;; wire-based connection is disconnected; it had better know it
             (check-false (connected? cx)))
-          (check-completes (lambda () (disconnect cx)) "disconnect"))))
+          (check-completes (lambda () (disconnect cx)) "disconnect")
+          (check-false (connected? cx)))))
 
-    ;; FIXME: Still need to test the disconnect works on cx left locked
-    ;; because of kill-thread (currently probably doesn't for sqlite3,odbc).
-    ;; ie: "connected?, disconnect work w/ kill-thread 'damage'"
+    (test-case "connected?, disconnect work w/ kill-thread damage"
+      (let ([cx (connect-for-test)])
+        (when (is-a? cx locking%)
+          (check-true (connected? cx))
+          (let ([thd
+                 (thread
+                  (lambda ()
+                    (send cx call-with-lock 'test (lambda () (sync never-evt)))))])
+            (kill-thread thd)
+            (check-completes (lambda () (connected? cx)) "connected?")
+            (check-completes (lambda () (disconnect cx)) "disconnect")
+            (check-false (connected? cx))))))
     ))
 
 (define TIMEOUT 2) ;; seconds
diff --git a/collects/tests/db/db/query.rkt b/collects/tests/db/db/query.rkt
index 5b267f2912..c396daf566 100644
--- a/collects/tests/db/db/query.rkt
+++ b/collects/tests/db/db/query.rkt
@@ -33,8 +33,8 @@
 
   (test-suite (format "simple (~a)" prep-mode)
 
-    (test-case "query-exec"
-      (unless (ANYFLAGS 'isora 'isdb2) ;; table isn't temp, so don't tamper with it
+    (unless (ANYFLAGS 'isora 'isdb2) ;; table isn't temp, so don't tamper with it
+      (test-case "query-exec"
         (with-connection c
           (check-pred void? (Q c query-exec "insert into the_numbers values(-1, 'mysterious')"))
           (check-equal? (Q c query-value "select descr from the_numbers where N = -1")
@@ -143,8 +143,8 @@
           (check set-equal?
                  (map vector (map car test-data))
                  (rows-result-rows q)))))
-    (test-case "query - update"
-      (unless (ANYFLAGS 'isora 'isdb2)
+    (unless (ANYFLAGS 'isora 'isdb2)
+      (test-case "query - update"
         (with-connection c
           (let [(q (query c "update the_numbers set N = -1 where N = 1"))]
             (check-pred simple-result? q)))))
@@ -226,8 +226,8 @@
 
     ;; Added 18 May 2003: Corrected a bug which incorrectly interleaved
     ;; nulls with returned fields.
-    (test-case "nulls arrive in correct order"
-      (unless (TESTFLAGS 'odbc 'issl)
+    (unless (TESTFLAGS 'odbc 'issl)
+      (test-case "nulls arrive in correct order"
         (with-connection c
           ;; raw NULL has PostgreSQL type "unknown", not allowed
           (define (clean . strs)
@@ -257,8 +257,8 @@
     (test-case "query - not a statement"
       (with-connection c
         (check-exn exn:fail? (lambda () (query c 5)))))
-    (test-case "query - multiple statements in string"
-      (unless (or (TESTFLAGS 'odbc 'ispg) (ANYFLAGS 'isdb2))
+    (unless (or (TESTFLAGS 'odbc 'ispg) (ANYFLAGS 'isdb2))
+      (test-case "query - multiple statements in string"
         (with-connection c
           (check-exn exn:fail?
                      (lambda ()
@@ -276,6 +276,65 @@
         (check-equal? (query-value c (select-val "17"))
                       (if (TESTFLAGS 'odbc 'issl) "17" 17))))))
 
+(define virtual-statement-tests
+  (let ()
+    (define (check-prep-once mk-connection)
+      (let* ([counter 0]
+             [c (mk-connection)]
+             [vstmt (virtual-statement
+                     (lambda (dbsys)
+                       (set! counter (add1 counter))
+                       (select-val "17")))])
+        (query-value c vstmt)
+        (check-equal? counter 1 "first query")
+        (query-value c vstmt)
+        (check-equal? counter 1 "second query")
+        (disconnect c)))
+    (test-suite "virtual-statements"
+      (test-case "prep once"
+        (check-prep-once connect-and-setup))
+      (test-case "prep once for virtual-connection"
+        (check-prep-once
+         (lambda () (virtual-connection connect-and-setup))))
+      (test-case "prep once for virtual-connection/pool"
+        (check-prep-once
+         (lambda () (virtual-connection (connection-pool connect-and-setup))))))))
+
+(define pool-tests
+  (test-suite "connection pools"
+    (test-case "lease, limit, release"
+      (let* ([counter 0]
+             [p (connection-pool (lambda () (set! counter (+ 1 counter)) (connect-for-test))
+                                 #:max-connections 2)]
+             [c1 (connection-pool-lease p)]
+             [c2 (connection-pool-lease p)])
+        ;; Two created
+        (check-equal? counter 2)
+        ;; Can't create new one yet
+        (check-exn exn:fail? (lambda () (connection-pool-lease p)))
+        ;; But if we free one...
+        (disconnect c2)
+        (check-equal? (connected? c2) #f)
+        (let ([c3 (connection-pool-lease p)])
+          (check-equal? counter 2 "not new") ;; used idle, not new connection
+          (check-equal? (connected? c3) #t))))
+    (test-case "release on evt"
+      (let* ([p (connection-pool connect-for-test #:max-connections 2)]
+             [sema (make-semaphore 0)]
+             [c1 (connection-pool-lease p sema)])
+        (check-equal? (connected? c1) #t)
+        ;; Closes when evt ready
+        (begin (semaphore-post sema) (sleep 0.1))
+        (check-equal? (connected? c1) #f)))
+    (test-case "release on custodian"
+      (let* ([p (connection-pool connect-for-test #:max-connections 2)]
+             [cust (make-custodian)]
+             [c1 (connection-pool-lease p cust)])
+        (check-equal? (connected? c1) #t)
+        ;; Closes when custodian shutdown
+        (begin (custodian-shutdown-all cust) (sleep 0.1))
+        (check-equal? (connected? c1) #f)))))
+
 (define test
   (test-suite "query API"
     (simple-tests 'string)
@@ -284,4 +343,6 @@
     (simple-tests 'gen)
     low-level-tests
     misc-tests
+    virtual-statement-tests
+    pool-tests
     error-tests))
diff --git a/collects/tests/db/db/sql-types.rkt b/collects/tests/db/db/sql-types.rkt
index ed5aa436bc..ed42b49fbc 100644
--- a/collects/tests/db/db/sql-types.rkt
+++ b/collects/tests/db/db/sql-types.rkt
@@ -12,8 +12,6 @@
 (import config^ database^)
 (export test^)
 
-(define dbsystem #f) ;; hack, set within test suite
-
 (define current-type (make-parameter #f))
 
 (define-syntax-rule (type-test-case types . body)
@@ -23,10 +21,9 @@
   (let* ([known-types (send dbsystem get-known-types)]
          [type (for/or ([type types])
                 (and (member type known-types) type))])
-    (if type
-        (test-case (format "~s" type)
-          (parameterize ((current-type type)) (proc)))
-        (test-case (format "unsupported: ~s" types) (void)))))
+    (when type
+      (test-case (format "~s" type)
+        (parameterize ((current-type type)) (proc))))))
 
 (define (check-timestamptz-equal? a b)
   (check srfi:time=?
@@ -143,11 +140,6 @@
 
 (define test
   (test-suite "SQL types (roundtrip, etc)"
-    #:before (lambda ()
-               (call-with-connection
-                (lambda (c) (set! dbsystem (connection-dbsystem c)))))
-    #:after (lambda () (set! dbsystem #f))
-
     (type-test-case '(bool boolean)
       (call-with-connection
        (lambda (c)
@@ -205,19 +197,20 @@
            (check-roundtrip c -inf.0)
            (check-roundtrip c +nan.0)))))
 
-    (type-test-case '(numeric decimal)
-      (unless (ANYFLAGS 'isdb2) ;; "Driver not capable"
+    (unless (ANYFLAGS 'isdb2) ;; "Driver not capable"
+      (type-test-case '(numeric decimal)
         (call-with-connection
          (lambda (c)
            (check-roundtrip c 0)
            (check-roundtrip c 10)
            (check-roundtrip c -5)
-           (check-roundtrip c 1/2)
-           (check-roundtrip c 1/40)
-           (check-roundtrip c #e1234567890.0987654321)
-           (check-roundtrip c 1/10)
-           (check-roundtrip c 1/400000)
-           (check-roundtrip c 12345678901234567890)
+           (unless (TESTFLAGS 'odbc 'ismy)
+             (check-roundtrip c 12345678901234567890)
+             (check-roundtrip c 1/2)
+             (check-roundtrip c 1/40)
+             (check-roundtrip c #e1234567890.0987654321)
+             (check-roundtrip c 1/10)
+             (check-roundtrip c 1/400000))
            (when (supported? 'numeric-infinities)
              (check-roundtrip c +nan.0))))))
 
diff --git a/collects/tests/db/gen/query.rkt b/collects/tests/db/gen/query.rkt
new file mode 100644
index 0000000000..a858816329
--- /dev/null
+++ b/collects/tests/db/gen/query.rkt
@@ -0,0 +1,57 @@
+#lang racket/base
+(require rackunit
+         racket/class
+         (prefix-in srfi: srfi/19)
+         db/base
+         "../config.rkt")
+
+(provide query:test)
+
+(define vehicles-result
+  (rows-result
+   '(((name . "type")) ((name . "maker")) ((name . "model")))
+   `(#("car"  "honda"   "civic")
+     #("car"  "ford"    "focus")
+     #("car"  "ford"    "pinto")
+     #("bike" "giant"   "boulder")
+     #("bike" "schwinn" ,sql-null))))
+
+(define query:test
+  (test-suite "Query utilities"
+    (test-suite "group-rows"
+      (test-case "single grouping"
+        (check-equal?
+         (rows-result-rows (group-rows vehicles-result #:group '#("type")))
+         `(#("car" (#("honda" "civic")
+                    #("ford" "focus")
+                    #("ford" "pinto")))
+           #("bike" (#("giant" "boulder")
+                     #("schwinn" ,sql-null))))))
+      (test-case "multiple groupings"
+        (check-equal?
+         (rows-result-rows
+          (group-rows vehicles-result #:group '(#("type") #("maker"))))
+         `(#("car" (#("honda" (#("civic")))
+                    #("ford"  (#("focus") #("pinto")))))
+           #("bike" (#("giant" (#("boulder")))
+                     #("schwinn" ()))))))
+      (test-case "multiple groupings, preserve null rows"
+        (check-equal?
+         (rows-result-rows
+          (group-rows vehicles-result
+                      #:group '(#("type") #("maker"))
+                      #:group-mode '(preserve-null-rows)))
+         `(#("car" (#("honda" (#("civic")))
+                    #("ford"  (#("focus") #("pinto")))))
+           #("bike" (#("giant" (#("boulder")))
+                     #("schwinn" (#(,sql-null))))))))
+      (test-case "multiple groupings, list"
+        (check-equal?
+         (rows-result-rows
+          (group-rows vehicles-result
+                      #:group '(#("type") #("maker"))
+                      #:group-mode '(list)))
+         `(#("car" (#("honda" ("civic"))
+                    #("ford"  ("focus" "pinto"))))
+           #("bike" (#("giant" ("boulder"))
+                     #("schwinn" ())))))))))
diff --git a/collects/tests/drracket/hangman.rkt b/collects/tests/drracket/hangman.rkt
index c29ee1facd..844c7a5bf8 100644
--- a/collects/tests/drracket/hangman.rkt
+++ b/collects/tests/drracket/hangman.rkt
@@ -3,6 +3,7 @@
          racket/class)
 
 (fire-up-drscheme-and-run-tests 
+ #:use-focus-table? #f
  (λ ()
    (define drs (wait-for-drscheme-frame))
    (define defs (send drs get-definitions-text))
diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt
index a2a5b62f28..8bf26b1bf7 100644
--- a/collects/tests/drracket/language-test.rkt
+++ b/collects/tests/drracket/language-test.rkt
@@ -1107,10 +1107,10 @@ the settings above should match r5rs
 (define (test-setting set-setting setting-name expression result)
   (set-language #f)
   (set-setting)
-  (let ([f (get-top-level-focus-window)])
+  (let ([f (test:get-active-top-level-window)])
     (fw:test:button-push "OK")
     (wait-for-new-frame f))
-  (let* ([drs (get-top-level-focus-window)]
+  (let* ([drs (test:get-active-top-level-window)]
          [interactions (send drs get-interactions-text)])
     (clear-definitions drs)
     (type-in-definitions drs expression)
@@ -1124,7 +1124,7 @@ the settings above should match r5rs
 (define (test-hash-bang)
   (let* ([expression "#!/bin/sh\n1"]
          [result "1"]
-         [drs (get-top-level-focus-window)]
+         [drs (test:get-active-top-level-window)]
          [interactions (queue-callback (λ () (send drs get-interactions-text)))])
     (clear-definitions drs)
     (type-in-definitions drs expression)
@@ -1235,7 +1235,7 @@ the settings above should match r5rs
             (fw:test:set-check-box!
              "Insert newlines in printed values"
              pretty?)
-            (let ([f (get-top-level-focus-window)])
+            (let ([f (test:get-active-top-level-window)])
               (fw:test:button-push "OK")
               (wait-for-new-frame f)))]
          [shorten
diff --git a/collects/tests/drracket/module-lang-test-utils.rkt b/collects/tests/drracket/module-lang-test-utils.rkt
index 6782c02d92..284899f0d9 100644
--- a/collects/tests/drracket/module-lang-test-utils.rkt
+++ b/collects/tests/drracket/module-lang-test-utils.rkt
@@ -147,7 +147,7 @@
   
   (set-module-language! #f)
   (test:set-radio-box-item! "Debugging")
-  (let ([f (queue-callback/res (λ () (get-top-level-focus-window)))])
+  (let ([f (queue-callback/res (λ () (test:get-active-top-level-window)))])
     (test:button-push "OK")
     (wait-for-new-frame f))
 
@@ -163,7 +163,7 @@
   (define (setup-dialog/run proc)
     (set-module-language! #f)
     (proc)
-    (let ([f (get-top-level-focus-window)])
+    (let ([f (test:get-active-top-level-window)])
       (test:button-push "OK")
       (wait-for-new-frame f))
     (do-execute drs)
diff --git a/collects/tests/drracket/no-write-and-frame-leak.rkt b/collects/tests/drracket/no-write-and-frame-leak.rkt
index 1adbd72ef2..0a3b4f03b0 100644
--- a/collects/tests/drracket/no-write-and-frame-leak.rkt
+++ b/collects/tests/drracket/no-write-and-frame-leak.rkt
@@ -12,12 +12,6 @@
                      (error who "Deleting files is not allowed")))
                  void
                  void)])
-  (fire-up-drscheme-and-run-tests 
-   (λ ()
-     (define drs-frame (wait-for-drscheme-frame))
-     (test:menu-select "File" "Close"))))
-
-(parameterize ([current-command-line-arguments '#()])
   (fire-up-drscheme-and-run-tests 
    (λ ()
      (define drs-frame1 (wait-for-drscheme-frame))
@@ -29,7 +23,7 @@
      (define drs-tabb (make-weak-box (send drs-frame1 get-current-tab)))
      (define tab-nsb (make-weak-box (send (send (send drs-frame1 get-current-tab) get-ints) get-user-namespace)))
      
-     (test:menu-select "File" "Close Tab")
+     (test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Tab"))
      (sync (system-idle-evt))
      
      (test:menu-select "File" "New")
@@ -38,7 +32,7 @@
      (define drs-frame2b (make-weak-box (wait-for-new-frame drs-frame1)))
      (define frame2-nsb (make-weak-box (send (send (send (weak-box-value drs-frame2b) get-current-tab) get-ints) get-user-namespace)))
      
-     (test:menu-select "File" "Close")
+     (test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Window"))
      (sync (system-idle-evt))
      
      (let loop ([n 30])
diff --git a/collects/tests/drracket/private/drracket-test-util.rkt b/collects/tests/drracket/private/drracket-test-util.rkt
index 5d22431ccf..a0e377d9da 100644
--- a/collects/tests/drracket/private/drracket-test-util.rkt
+++ b/collects/tests/drracket/private/drracket-test-util.rkt
@@ -61,7 +61,7 @@
 	(fw:preferences:set 'framework:file-dialogs 'common)
 	(open-dialog)
 	(let ([dlg (wait-for-new-frame drs)])
-	  (send (find-labelled-window "Filename:") focus)
+	  (send (find-labelled-window "Filename:" #f (fw:test:get-active-top-level-window)) focus)
 	  (fw:test:keystroke #\a (list (case (system-type)
 					 [(windows) 'control]
 					 [(macosx macos) 'meta]
@@ -100,7 +100,7 @@
   (define (wait-for-drscheme-frame [print-message? #f])
     (let ([wait-for-drscheme-frame-pred
            (lambda ()
-             (let ([active (get-top-level-focus-window)])
+             (let ([active (fw:test:get-active-top-level-window)])
                (if (and active
                         (drscheme-frame? active))
                    active
@@ -123,15 +123,14 @@
      [(old-frame extra-eventspaces timeout)
       (let ([wait-for-new-frame-pred
 	     (lambda ()
-	       (let ([active (or (get-top-level-focus-window)
-				 (ormap
+	       (let ([active (or (fw:test:get-active-top-level-window)
+                                 (ormap
 				  (lambda (eventspace)
-				    (parameterize ([current-eventspace eventspace])
-				      (get-top-level-focus-window)))
+                                    (parameterize ([current-eventspace eventspace])
+                                      (fw:test:get-active-top-level-window)))
 				  extra-eventspaces))])
 		 (if (and active
-                          (send active get-focus-window)
-			  (not (eq? active old-frame)))
+                          (not (eq? active old-frame)))
 		     active
 		     #f)))])
 	(poll-until wait-for-new-frame-pred timeout))]))
@@ -172,7 +171,7 @@
   
   (define (verify-drscheme-frame-frontmost function-name frame)
     (on-eventspace-handler-thread 'verify-drscheme-frame-frontmost)
-    (let ([tl (get-top-level-focus-window)])
+    (let ([tl (fw:test:get-active-top-level-window)])
       (unless (and (eq? frame tl)
                    (drscheme-frame? tl))
         (error function-name "drscheme frame not frontmost: ~e (found ~e)" frame tl))))
@@ -180,9 +179,9 @@
   (define (clear-definitions frame)
     (queue-callback/res (λ () (verify-drscheme-frame-frontmost 'clear-definitions frame)))
     (fw:test:new-window (queue-callback/res (λ () (send frame get-definitions-canvas))))
-    (let ([window (queue-callback/res (λ () (send frame get-focus-window)))])
+    (let ([window (queue-callback/res (λ () (send frame get-edit-target-window)))])
       (let-values ([(cw ch) (queue-callback/res (λ () (send window get-client-size)))]
-		   [(w h) (queue-callback/res (λ () (send window get-size)))])
+                   [(w h) (queue-callback/res (λ () (send window get-size)))])
         (fw:test:mouse-click 'left
 			     (inexact->exact (floor (+ cw (/ (- w cw) 2))))
 			     (inexact->exact (floor (+ ch (/ (- h ch) 2)))))))
@@ -344,10 +343,10 @@
                    (andmap (lambda (x) (or string? regexp?)) in-language-spec))
         (error 'set-language-level! "expected a non-empty list of regexps and strings for language, got: ~e" in-language-spec))
       (not-on-eventspace-handler-thread 'set-language-level!)
-      (let ([drs-frame (get-top-level-focus-window)])
+      (let ([drs-frame (fw:test:get-active-top-level-window)])
         (fw:test:menu-select "Language" "Choose Language...")
         (let* ([language-dialog (wait-for-new-frame drs-frame)]
-               [language-choice (find-labelled-window #f hierarchical-list%)]
+               [language-choice (find-labelled-window #f hierarchical-list% (fw:test:get-active-top-level-window))]
                [b1 (box 0)]
                [b2 (box 0)]
                [click-on-snip
@@ -411,7 +410,7 @@
                        drs-frame)))))))) 
   (define (set-module-language! [close-dialog? #t])
     (not-on-eventspace-handler-thread 'set-module-language!)
-    (let ([drs-frame (get-top-level-focus-window)])
+    (let ([drs-frame (fw:test:get-active-top-level-window)])
       (fw:test:menu-select "Language" "Choose Language...")
       (let* ([language-dialog (wait-for-new-frame drs-frame)])
         (fw:test:set-radio-box-item! #rx"Use the language declared in the source")
@@ -594,7 +593,7 @@
   ;; but just to print and return.
   (define orig-display-handler (error-display-handler))
   
-  (define (fire-up-drscheme-and-run-tests run-test)
+  (define (fire-up-drscheme-and-run-tests #:use-focus-table? [use-focus-table? #t] run-test)
     (on-eventspace-handler-thread 'fire-up-drscheme-and-run-tests)
     (let ()
       ;; change the preferences system so that it doesn't write to 
@@ -616,7 +615,9 @@
       ;; been read by this point, but hopefully that won't affect much
       ;; of the startup of drscheme)
       (fw:preferences:restore-defaults)
-
+      
+      (fw:test:use-focus-table use-focus-table?)
+      
       (thread (λ () 
 		 (let ([orig-display-handler (error-display-handler)])
 		   (uncaught-exception-handler
diff --git a/collects/tests/drracket/private/randomly-click.rkt b/collects/tests/drracket/private/randomly-click.rkt
index a9ebd6e917..0e975eaf0e 100644
--- a/collects/tests/drracket/private/randomly-click.rkt
+++ b/collects/tests/drracket/private/randomly-click.rkt
@@ -69,7 +69,7 @@
      (send area get-label)]))
 
 (define (g open-dialog)
-  (let ((base-window (get-top-level-focus-window)))
+  (let ((base-window (test:get-active-top-level-window)))
     (open-dialog)
     (wait-for-different-frame base-window)
     (let loop ([n numButtonsToPush]
@@ -84,7 +84,7 @@
          (when (= 1 (modulo n 10)) (printf "\n"))
          (flush-output)
          
-         (let ((window (get-top-level-focus-window)))
+         (let ((window (test:get-active-top-level-window)))
            (cond
              ;; Back to base-window is not interesting, Reopen
              [(eq? base-window window)
@@ -92,9 +92,6 @@
               (wait-for-different-frame base-window)
               (loop (- n 1) actions)]
              
-             ;; get-top-level-focus-window returns #f may imply window not in current eventspace
-             ;; but it also might just mean we didn't look into subeventspaces(?)
-             ;; or that we need to wait for something to happen in the GUI(?)
              [(eq? window #f)
               (sleep .1)
               (loop (- n 1) actions)]
@@ -137,7 +134,7 @@
 ;; the splash screen is in a separate eventspace so wont' show up.
 (define (wait-for-first-frame)
   (let loop ()
-    (let ([tlw (get-top-level-focus-window)])
+    (let ([tlw (test:get-active-top-level-window)])
       (cond
         [(not tlw)
          (sleep 1/20)
@@ -151,7 +148,7 @@
       [(zero? n)
        (error 'wait-for-different-frame "never got that new window, only this one: ~s" win)]
       [else
-       (let ([tlw (get-top-level-focus-window)])
+       (let ([tlw (test:get-active-top-level-window)])
          (when (eq? win tlw)
            (sleep 1/10)
            (loop (- n 1))))])))
diff --git a/collects/tests/drracket/repl-test.rkt b/collects/tests/drracket/repl-test.rkt
index 051168a4e1..d32d03a809 100644
--- a/collects/tests/drracket/repl-test.rkt
+++ b/collects/tests/drracket/repl-test.rkt
@@ -1201,18 +1201,21 @@ This produces an ACK message
         (case language-cust
           [(raw) (void)]
           [else
+           (define edit-target (queue-callback/res (λ () (send drscheme-frame get-edit-target-window))))
+           (define defs-focus? (eq? edit-target definitions-canvas))
+           (define ints-focus? (eq? edit-target interactions-canvas))
            (cond
              [(eq? source-location 'definitions)
-              (unless (send definitions-canvas has-focus?)
+              (unless defs-focus?
                 (fprintf (current-error-port)
                          "FAILED execute test for ~s\n  expected definitions to have the focus\n"
                          program))]
              [(eq? source-location 'interactions)
-              (unless (send interactions-canvas has-focus?)
+              (unless ints-focus?
                 (fprintf (current-error-port)
                          "FAILED execute test for ~s\n  expected interactions to have the focus\n"
                          program))]
-             [(queue-callback/res (λ () (send definitions-canvas has-focus?)))
+             [defs-focus?
               (let ([start (car source-location)]
                     [finish (cdr source-location)])
                 (let* ([error-ranges (queue-callback/res (λ () (send interactions-text get-error-ranges)))]
@@ -1333,7 +1336,7 @@ This produces an ACK message
          (begin
            (set-language-level! level #f)
            (test:set-radio-box-item! "No debugging or profiling")
-           (let ([f (get-top-level-focus-window)])
+           (let ([f (test:get-active-top-level-window)])
              (test:button-push "OK")
              (wait-for-new-frame f)))]
         [(debug)
@@ -1342,7 +1345,7 @@ This produces an ACK message
          (begin
            (set-language-level! level #f)
            (test:set-radio-box-item! "Debugging and profiling")
-           (let ([f (get-top-level-focus-window)])
+           (let ([f (test:get-active-top-level-window)])
              (test:button-push "OK")
              (wait-for-new-frame f)))])
          
diff --git a/collects/tests/drracket/sample-solutions-one-window.rkt b/collects/tests/drracket/sample-solutions-one-window.rkt
index f0e2a88e7e..9ee0c97a64 100644
--- a/collects/tests/drracket/sample-solutions-one-window.rkt
+++ b/collects/tests/drracket/sample-solutions-one-window.rkt
@@ -110,7 +110,7 @@
                  (custodian-shutdown-all cust))))
             (let ([wait-for-kill-window
                    (lambda ()
-                     (let ([f (get-top-level-focus-window)])
+                     (let ([f (test:get-active-top-level-window)])
                        (and f (equal? (send f get-label)
                                       "Evaluation Terminated"))))])
               (poll-until wait-for-kill-window)
diff --git a/collects/tests/drracket/stepper-test.rkt b/collects/tests/drracket/stepper-test.rkt
index c9d660ec5a..7742c09805 100644
--- a/collects/tests/drracket/stepper-test.rkt
+++ b/collects/tests/drracket/stepper-test.rkt
@@ -488,7 +488,7 @@
       (set-definitions-to-program drs-frame program)
       (let* ([stepper-frame (start-stepper drs-frame)]
              [steps (get-all-steps stepper-frame)])
-        (test:menu-select "File" "Close")
+        (test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Window"))
         (let ([drs-frame1 (wait-for-new-frame stepper-frame)])
           (unless (eq? drs-frame1 drs-frame)
             (error 'step-and-extract "didn't get back to drscheme frame, got: ~e" drs-frame)))
diff --git a/collects/tests/drracket/teaching-lang-save-file.rkt b/collects/tests/drracket/teaching-lang-save-file.rkt
index 297b7b42b7..4856656572 100644
--- a/collects/tests/drracket/teaching-lang-save-file.rkt
+++ b/collects/tests/drracket/teaching-lang-save-file.rkt
@@ -30,7 +30,7 @@
          (error 'save-teaching-lang-file.rkt
                 "expected the saved file to contain the word 'metadata' in a comment"))
        (do-execute drr-frame)
-       (test:menu-select "File" "Close Tab")
+       (test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Tab"))
        (use-get/put-dialog 
         (λ () 
           (test:menu-select "File" "Open..."))
@@ -40,7 +40,7 @@
                       drr-frame
                       (send interactions-text paragraph-start-position 2)
                       (send interactions-text last-position))])
-         (test:menu-select "File" "Close Tab")
+         (test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Tab"))
          (delete-file fn)
          (unless (equal? result "1\n> ")
            (error 'save-teaching-lang-file.rkt "expected the program to produce 1 (followed by the prompt), got ~s" result)))))))
diff --git a/collects/tests/drracket/teachpack.rkt b/collects/tests/drracket/teachpack.rkt
index 2aabd7fd88..857a0a7462 100644
--- a/collects/tests/drracket/teachpack.rkt
+++ b/collects/tests/drracket/teachpack.rkt
@@ -1,9 +1,10 @@
-#lang scheme/base
+#lang racket/base
 
 (require "private/drracket-test-util.rkt"
-         scheme/class
-         scheme/path
-         scheme/gui/base
+         racket/class
+         racket/path
+         racket/gui/base
+         framework
          (prefix-in fw: framework))
 
 (provide run-test)
@@ -109,11 +110,11 @@
                     (lambda ()
                       (let ([active
                              (or
-                              (get-top-level-focus-window)
+                              (test:get-active-top-level-window)
                               (and (send interactions-text get-user-eventspace)
                                    (parameterize ([current-eventspace
                                                    (send interactions-text get-user-eventspace)])
-                                     (get-top-level-focus-window))))])
+                                     (test:get-active-top-level-window))))])
                         (if (and active (not (eq? active drs-frame)))
                             active
                             #f)))])
@@ -198,7 +199,7 @@
                   (fw:test:menu-select "Language" "Clear All Teachpacks")
                   (fw:test:menu-select "Language" "Add Teachpack...")
                   (wait-for-new-frame drs-frame)
-                  (let* ([tp-dialog (get-top-level-focus-window)]
+                  (let* ([tp-dialog (test:get-active-top-level-window)]
                          [choice (find/select-relevant-choice tp-dialog (path->string teachpack))])
                     (fw:test:button-push "OK")
                     (wait-for-new-frame tp-dialog))
diff --git a/collects/tests/drracket/test-engine-test.rkt b/collects/tests/drracket/test-engine-test.rkt
index ad421d727b..e78232459b 100644
--- a/collects/tests/drracket/test-engine-test.rkt
+++ b/collects/tests/drracket/test-engine-test.rkt
@@ -201,10 +201,10 @@
 (define (test-setting set-setting setting-name expression result)
   (set-language #f)
   (set-setting)
-  (let ([f (get-top-level-focus-window)])
+  (let ([f (test:get-active-top-level-window)])
     (fw:test:button-push "OK")
     (wait-for-new-frame f))
-  (let* ([drs (get-top-level-focus-window)]
+  (let* ([drs (test:get-active-top-level-window)]
          [interactions (send drs get-interactions-text)])
     (clear-definitions drs)
     (type-in-definitions drs expression)
diff --git a/collects/tests/drracket/time-keystrokes.rkt b/collects/tests/drracket/time-keystrokes.rkt
index c1e57b1017..6980a475fd 100644
--- a/collects/tests/drracket/time-keystrokes.rkt
+++ b/collects/tests/drracket/time-keystrokes.rkt
@@ -41,7 +41,7 @@
         (let loop ([n 10])
           (when (zero? n)
             (error 'time-keystrokes "could not find drscheme frame"))
-          (let ([front-frame (get-top-level-focus-window)])
+          (let ([front-frame (test:get-active-top-level-window)])
             (unless (eq? front-frame frame)
               (sleep 1/10)
               (loop (- n 1)))))
diff --git a/collects/tests/honu/macros.rkt b/collects/tests/honu/macros.rkt
index 4a4646769f..cc9255503a 100644
--- a/collects/tests/honu/macros.rkt
+++ b/collects/tests/honu/macros.rkt
@@ -1,61 +1,8 @@
 #lang honu
 
-// display(1);
+macro testx () {x:expression} {syntax(x_result + 1)}
 
-/*
-=> 
+testx 5 * 2;
 
-x = function(q){
-  print q;
-  if (q < end){
-    x(q+1);
-  }
-}
-x(start);
-*/
-
-/*
-
-// display(syntax ...);
-
-macro (to2){{fuz
-            x ... to2
-               }}
-{{
-  display(x);
-         ...
-  }}
-
-fuz 5 6 to2
-
-// macro (to = do end) {{ for looper:id = first:expr to last:expr do
-
-                           /*
-macro (to = do end) {{ for looper = first to last do
-  body ...
-}}
-{{
-  /* display(2); */
-  var x = function(looper){
-    body ...
-    if (looper < last){
-      x(looper+1);
-    }
-  };
-  x(first);
-}}
-                           
-
-/*
-for2 x = 1 to 10 do
-  display(x);
-  newline();
-end
-*/
-
-for x = 1 to 10 do
-  display(x);
-  newline();
-
-                           */
-*/
+for z = 1 to testx 5 * 2 do
+  printf("z is ~a\n", z)
diff --git a/collects/tests/honu/test.rkt b/collects/tests/honu/test.rkt
deleted file mode 100644
index 0b53bd27ce..0000000000
--- a/collects/tests/honu/test.rkt
+++ /dev/null
@@ -1,74 +0,0 @@
-#lang racket/base
-
-#|
-(require 
-  (prefix-in macro_ honu/core/private/macro2)
-  (rename-in honu/core/private/honu2
-             [honu-function honu_function]
-             [honu-+ honu_plus]
-             [honu-* honu_times]
-             [honu-/ honu_division]
-             [honu-- honu_minus])
-  (rename-in honu/core/private/literals
-             [honu-= =]
-             [semicolon |;|])
-  (rename-in (only-in honu/core/private/honu-typed-scheme honu-var)
-             [honu-var var])
-  (for-syntax racket/base
-              honu/core/private/macro2
-              syntax/stx
-              racket/port
-              syntax/parse
-              (prefix-in parse: honu/core/private/parse2))
-  racket/port)
-
-(define-syntax (fake-module-begin stx)
-  (syntax-case stx ()
-    [(_ stuff)
-     (let ()
-       (define output (parse:parse-all (stx-cdr #'stuff)))
-       (printf "Output: ~a\n" (syntax->datum output))
-       output)]))
-
-#;
-(fake-module-begin #hx(macro_macro foo (){ x:number }{
-                            withSyntax [z 5]{
-                               syntax(print(x); print(z););
-                            }
-                         }
-                         foo 5))
-
-                   #;
-(fake-module-begin #hx(2))
-
-(fake-module-begin #hx(1;2))
-
-(fake-module-begin #hx(var x = 2;
-                       print(x)))
-
-#|
-
-(let ()
-  (fake-module-begin #hx(honu_function test(x){
-                                       print(x)
-                                       }))
-  (test 5))
-
-(let ()
-  (fake-module-begin #hx(honu_function test(x){
-                                       print(x);
-                                       print(x)
-                                       }
-                         test(2))))
-
-
-(let ()
-  (fake-module-begin #hx(1 honu_plus 1)))
-
-(let ()
-  (fake-module-begin #hx(1 honu_plus 1 honu_minus 4)))
-
-(let ()
-  (fake-module-begin #hx(1 honu_plus 1 honu_minus 4 honu_times 8)))
-|#
-|#
diff --git a/collects/tests/htdp-lang/intm-adv.rktl b/collects/tests/htdp-lang/intm-adv.rktl
index c032984b98..6757cb56a3 100644
--- a/collects/tests/htdp-lang/intm-adv.rktl
+++ b/collects/tests/htdp-lang/intm-adv.rktl
@@ -115,3 +115,15 @@
 (htdp-err/rt-test (-) (exn-type-and-msg exn:application:arity? "-: expects at least 1 argument, given 0"))
 (htdp-err/rt-test (/) (exn-type-and-msg exn:application:arity? "/: expects at least 1 argument, given 0"))
 ;(htdp-test 1 (/ 1) exn:application:arity?)
+
+;; Check that `local' works with macros that expand to `begin':
+(module my-multi-defn racket/base
+  (provide multi)
+  (define-syntax-rule (multi a b)
+    (begin
+      (define a 1)
+      (define b 2))))
+(htdp-teachpack my-multi-defn)
+
+(htdp-test '(2 1) 'local (local [(multi x y)]
+                           (list y x)))
diff --git a/collects/tests/lazy/lang.rkt b/collects/tests/lazy/lang.rkt
index 977cf7a190..c7129f1153 100644
--- a/collects/tests/lazy/lang.rkt
+++ b/collects/tests/lazy/lang.rkt
@@ -209,4 +209,5 @@
             (list-tests)
             (take-tests)
             (misc-tests)
-            (pcps-tests))))
+            (pcps-tests)
+            (strictness-tests))))
diff --git a/collects/tests/match/examples.rkt b/collects/tests/match/examples.rkt
index d7f2ad870a..5df53af8aa 100644
--- a/collects/tests/match/examples.rkt
+++ b/collects/tests/match/examples.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require scheme/match 
+(require scheme/match
 	 scheme/mpair
          scheme/control scheme/foreign
          (for-syntax scheme/base)
@@ -54,10 +54,10 @@
 (provide new-tests)
 
 (define new-tests
-  (test-suite 
+  (test-suite
    "new tests for match"
-   
-   (comp 
+
+   (comp
     1
     (match (list 1 2 3)
       [(list x ...) (=> unmatch)
@@ -66,26 +66,26 @@
                                (error 'bad))
                         0)]
       [_ 1]))
-   
-   (comp 
+
+   (comp
     '(1 2 3)
     (match (vector 1 2 3)
       [(vector (? number? x) ...) x]
       [_ 2]))
-   
+
    (comp
     2
     (match (vector 'a 1 2 3)
       [(vector (? number? x) ...) x]
       [_ 2]))
-   
+
    (comp
     3
     (match (list 'a 1 2 3)
       [(vector (? number? x) ...) x]
       [_ 3]))
-   
-   
+
+
    (comp -1
          (match (vector 1 2 3)
            [(or (list x) x) -1]
@@ -94,7 +94,7 @@
            [(vector a b) 2]
            [(vector a b c) 3]
            [(box _) 4]))
-   
+
    (comp 12
          (match (list 12 12)
            [(list x x) x]
@@ -103,8 +103,8 @@
          (match (list 1 0)
            [(list x x) x]
            [_ 13]))
-   
-   
+
+
    (comp
     6
     (let ()
@@ -123,84 +123,84 @@
         [(cons x y) (+ x y)]
         [_ 0])))
 
-   
+
    (comp
     6
     (match (make-X 1 2 3)
       [(X: a b c) (+ a b c)]))
-   
 
-   
-   (comp 
+
+
+   (comp
     '(6 3 100 6)
     (list
      (f (cons 1 2) (cons 3 4))
      (f (box 1) (box 2))
      (f (list 10 20 30) (list 40))
      (f (vector 1 2 3) (vector 4))))
-   
+
    (comp '(one (2 num) bool neither)
          (list
           (g 1)
           (g 2)
           (g #f)
           (g "foo")))
-   
+
    (comp
     (split (list (list 1 2) (list 'a 'b) (list 'x 'y)))
     '((1 a x) (2 b y)))
    (comp
     (split2 (list (list 1 2) (list 'a 'b) (list 'x 'y)))
     '((1 a) (2 b) (x y)))
-   
+
    (comp
     'yes
     (match (list (box 2) 2)
       [(list (or (box x) (list x)) x) 'yes]
       [_ 'no]))
-   
+
    (comp
     'no
     (parameterize ([match-equality-test eq?])
       (match (list (cons 1 1) (cons 1 1))
         [(list x x) 'yes]
         [_ 'no])))
-   
+
    (comp
     'no
     (match (list (box 2) 3)
       [(list (or (box x) (list x)) x) 'yes]
       [_ 'no]))
-   
+
    (comp
     2
     (match (list 'one 'three)
       [(list 'one 'two) 1]
       [(list 'one 'three) 2]
       [(list 'two 'three) 3]))
-   (comp 
+   (comp
     2
     (match (list 'one 'three)
       [(cons 'one (cons 'two '())) 1]
       [(cons 'one (cons 'three '())) 2]
       [(cons 'two (cons 'three '())) 3]))
-   
+
    (comp 'yes
          (match '(1 x 2 y 3 z)
            [(list-no-order 1 2 3 'x 'y 'z) 'yes]
            [_ 'no]))
-   
+
    ;; NOT WORKING YET
    (comp '(x y z)
          (match '(1 x 2 y 3 z)
            [(list-no-order 1 2 3 r1 r2 r3) (list r1 r2 r3)]
            [_ 'no]))
-   
+
    (comp '(x y z)
          (match '(1 x 2 y 3 z)
            [(list-no-order 1 2 3 rest ...) rest]
            [_ 'no]))
-   
+
    (comp
     'yes
     (match '(a (c d))
@@ -209,18 +209,18 @@
                          (list-no-order 'c 'd)))
        'yes]
       [_ 'no]))
-   
-   
-   (comp 
+
+
+   (comp
     '((1 2) (a b 1 2))
     (let ()
       (define-syntax-rule (match-lambda . cl)
         (lambda (e) (match e . cl)))
-      
+
       (define (make-nil)
         '())
       (define nil? null?)
-      
+
       (define make-::
         (match-lambda
           ((list-no-order (list '|1| a) (list '|2| d))
@@ -229,7 +229,7 @@
       (define (::-content p)
         (list (list '|1| (car p))
               (list '|2| (cdr p))))
-      
+
       (define my-append
         (match-lambda
           ((list-no-order (list '|1| (? nil?))
@@ -245,11 +245,11 @@
       (list
        (my-append (list (list '|1| '())
                         (list '|2| '(1 2))))
-       
+
        (my-append (list (list '|1| '(a b))
                         (list '|2| '(1 2)))))))
-   
-   
+
+
    (comp
     'yes
     (match
@@ -260,63 +260,63 @@
                                        (cons '|2| (cdr p)))))
                               (hash-table ('|1| _) ('|2| _))))) 'yes]
       [_ 'no]))
-   
+
    ;; examples from docs
-   
+
    (comp 'yes
          (match '(1 2 3)
            [(list (not 4) ...) 'yes]
            [_ 'no]))
-   
+
    (comp 'no
          (match '(1 4 3)
            [(list (not 4) ...) 'yes]
            [_ 'no]))
-   
+
    (comp 1
          (match '(1 2)
            [(or (list a 1) (list a 2)) a]
            [_ 'bad]))
-   
+
    (comp '(2 3)
-         (match '(1 (2 3) 4)          
+         (match '(1 (2 3) 4)
            [(list _ (and a (list _ ...)) _) a]
            [_ 'bad]))
-   
-   
-   
-   (comp 
+
+
+
+   (comp
     'yes
     (match "apple"
       [(regexp #rx"p+(.)" (list _ "l")) 'yes]
       [_ 'no]))
-   (comp 
+   (comp
     'no
     (match "append"
       [(regexp #rx"p+(.)" (list _ "l")) 'yes]
       [_ 'no]))
-   
-   
-   (comp 
+
+
+   (comp
     'yes
     (match "apple"
       [(regexp #rx"p+" ) 'yes]
       [_ 'no]))
-   (comp 
+   (comp
     'no
     (match "banana"
       [(regexp #rx"p+") 'yes]
       [_ 'no]))
-   
-   (comp 
+
+   (comp
     '(0 1)
     (let ()
       (define-struct tree (val left right))
-      
-      (match (make-tree 0 (make-tree 1 #f #f) #f)   
+
+      (match (make-tree 0 (make-tree 1 #f #f) #f)
         [(struct tree (a (struct tree (b  _ _)) _)) (list a b)]
         [_ 'no])))
-   
+
    (comp 1
          (match #&1
            [(box a) a]
@@ -325,120 +325,120 @@
          (match #hasheq(("a" . 1) ("b" . 2))
            [(hash-table ("b" b) ("a" a)) (list b a)]
            [_ 'no]))
-   
+
    (comp #t
          (andmap string?
                  (match #hasheq(("b" . 2) ("a" . 1))
                    [(hash-table (key val) ...) key]
                    [_ 'no])))
-   
+
    (comp
     (match #(1 (2) (2) (2) 5)
       [(vector 1 (list a) ..3 5) a]
       [_ 'no])
     '(2 2 2))
-   
+
    (comp '(1 3 4 5)
-         (match '(1 2 3 4 5 6)          
+         (match '(1 2 3 4 5 6)
            [(list-no-order 6 2 y ...) y]
            [_ 'no]))
-   
+
    (comp 1
-         (match '(1 2 3)          
+         (match '(1 2 3)
            [(list-no-order 3 2 x) x]))
    (comp '((1 2 3) 4)
-         (match '(1 2 3 . 4)          
+         (match '(1 2 3 . 4)
            [(list-rest a ... d) (list a d)]))
-   
+
    (comp 4
          (match '(1 2 3 . 4)
            [(list-rest a b c d) d]))
-   
+
    ;; different behavior from the way match used to be
    (comp '(2 3 4)
          (match '(1 2 3 4 5)
-           [(list 1 a ..3 5) a]      
+           [(list 1 a ..3 5) a]
            [_ 'else]))
-   
+
    (comp '((1 2 3 4) ())
          (match (list 1 2 3 4 5)
            [(list x ... y ... 5) (list x y)]
            [_ 'no]))
-   
+
    (comp '((1 3 2) (4))
          (match (list 1 3 2 3 4 5)
            [(list x ... 3 y ... 5) (list x y)]
            [_ 'no]))
-   
+
    (comp '(3 2 1)
          (match '(1 2 3)
            [(list a b c) (list c b a)]))
-   
+
    (comp '(2 3)
          (match '(1 2 3)
            [(list 1 a ...) a]))
-   
+
    (comp 'else
          (match '(1 2 3)
            [(list 1 a ..3) a]
            [_ 'else]))
-   
+
    (comp '(2 3 4)
          (match '(1 2 3 4)
            [(list 1 a ..3) a]
            [_ 'else]))
-   
+
    (comp
     '(2 2 2)
     (match '(1 (2) (2) (2) 5)
       [(list 1 (list a) ..3 5) a]
       [_ 'else]))
-   
+
    (comp
     #t
     (match "yes"
       ["yes" #t]
       ["no" #f]))
-   
+
    (comp 3
          (match '(1 2 3)
            [(list _ _ a) a]))
    (comp '(3 2 1)
-         (match '(1 2 3)          
-           [(list a b a) (list a b)]          
+         (match '(1 2 3)
+           [(list a b a) (list a b)]
            [(list a b c) (list c b a)]))
-   
+
    (comp '(2 '(x y z) 1)
-         (match '(1 '(x y z) 2) 
-           [(list a b a) (list a b)]          
+         (match '(1 '(x y z) 2)
+           [(list a b a) (list a b)]
            [(list a b c) (list c b a)]))
-   
+
    (comp '(1 '(x y z))
-         (match '(1 '(x y z) 1) 
-           [(list a b a) (list a b)]          
+         (match '(1 '(x y z) 1)
+           [(list a b a) (list a b)]
            [(list a b c) (list c b a)]))
-   
+
    (comp '(2 3)
          (match '(1 2 3)
            [`(1 ,a ,(? odd? b)) (list a b)]))
-   
+
    (comp '(2 1 (1 2 3 4))
-         (match-let ([(list a b) '(1 2)]                  
-                     [(vector x ...) #(1 2 3 4)])        
+         (match-let ([(list a b) '(1 2)]
+                     [(vector x ...) #(1 2 3 4)])
            (list b a x)))
-   
-   
-   
+
+
+
    (comp '(1 2 3 4)
-         (match-let* ([(list a b) '(#(1 2 3 4) 2)]                   
-                      [(vector x ...) a])   
+         (match-let* ([(list a b) '(#(1 2 3 4) 2)]
+                      [(vector x ...) a])
            x))
-   
+
    (comp 2
          (let ()
            (match-define (list a b) '(1 2))
            b))
-   
+
    (comp 'yes
          (match '(number_1 . number_2)
            [`(variable-except ,@(list vars ...))
@@ -446,7 +446,7 @@
            [(? list?)
             'no]
            [_ 'yes]))
-   
+
    (comp "yes"
          (match
              '((555))
@@ -454,7 +454,7 @@
                                 (list-no-order 555)))
             "yes")
            (_ "no"))) ;; prints "no"
-   
+
    (comp "yes"
          (match
              '((555))
@@ -462,7 +462,7 @@
                                 (list 555)))
             "yes")
            (_ "no"))) ;; prints "yes"
-   
+
    (comp "yes"
          (match
              '((555))
@@ -470,36 +470,36 @@
                        (list-no-order 555)))
             "yes")
            (_ "no"))) ;; prints "yes"
-   
+
    (comp  '("a") (match "a"  ((regexp #rx"a" x) x)))
-   (comp  '(#"a") 
+   (comp  '(#"a")
           (match #"a"
             ((regexp #rx"a" x) x)
             [_ 'no]))
-   
+
    (comp 'yes (match #"a" (#"a" 'yes)))
-   
+
    (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]) (expand #'(match-lambda ((a ?) #f))) 'no))
    (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]) (expand #'(match-lambda ((?) #f))) 'no))
-   
+
    (comp
     'yes
     (let ()
-      
+
       (m:define-match-expander exp1
                                #:plt-match
                                (lambda (stx)
                                  (syntax-case stx ()
                                    ((_match (x y))
                                     #'(list (list x y))))))
-      
+
       (m:define-match-expander exp2
                                #:plt-match
                                (lambda (stx)
                                  (syntax-case stx ()
                                    ((_match x y)
                                     #'(exp1 (x y))))))
-      
+
       (define (test tp)
         (match tp ((exp2 x y) x)))
       'yes))
@@ -510,28 +510,28 @@
          (let ()
            (define (foo x) (match x [1 (+ x x)]))
            (foo 1)))
-   
-   
+
+
    (comp 'yes
          (match (make-empt)
            [(struct empt ()) 'yes]
            [_ 'no]))
-   
+
    (comp 'yes
          (m:match (make-empt)
                   [($ empt) 'yes]
                   [_ 'no]))
-   
+
    (comp 3
          (match (mcons 1 2)
            [(mcons a b) (+ a b)]
            [_ 'no]))
-   
+
    (comp 3
          (match (mlist 1 2)
            [(mlist a b) (+ a b)]
            [_ 'no]))
-   
+
    (comp 3
          (match (mlist 1 2)
            [(mlist a ...) (apply + a)]
@@ -539,7 +539,7 @@
 
    (comp 1
          (match (box 'x) ('#&x 1) (else #f)))
-   
+
    (comp 2
          (match (vector 1 2) ('#(1 2) 2) (else #f)))
 
@@ -548,7 +548,7 @@
                          [values (lambda _ 'no)])
                 (match 1)
                 'no))
-   
+
    (comp 'yes
          (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]
                          [values (lambda _ 'no)])
@@ -560,49 +560,49 @@
                        0))))
 
    ;; raises error
-   (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]) 
+   (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)])
                 (expand (quote-syntax (match '(1 x 2 y 3 z)
                                         [(list-no-order 1 2 3 rest ... e) rest]
                                         [_ 'no])))
                 'no))
-   (comp '((2 4) (2 1))   
+   (comp '((2 4) (2 1))
          (match '(3 2 4 3 2 1)
-           [(list x y ... x z ...) 
+           [(list x y ... x z ...)
             (list y z)]))
 
    (comp '(1 2)
          (match-let ([(vector a b) (vector 1 2)])
                     (list a b)))
-   
+
    (comp '(4 5)
          (let-values ([(x y)
                        (match 1
                          [(or (and x 2) (and x 3) (and x 4)) 3]
                          [_ (values 4 5)])])
            (list x y)))
-   
+
    (comp 'bad
-         (match #(1) 
+         (match #(1)
            [(vector a b) a]
            [else 'bad]))
 
    (comp '(1 2)
-         (call-with-values 
-          (lambda () 
+         (call-with-values
+          (lambda ()
             (match 'foo [_ (=> skip) (skip)] [_ (values 1 2)]))
           list))
    (comp 0
          (let ([z (make-parameter 0)])
            (match 1
-             [(? number?) (=> f) (parameterize ([z 1]) (f))] 
+             [(? number?) (=> f) (parameterize ([z 1]) (f))]
              [(? number?) (z)])))
-   
+
    ;; make sure the prompts don't interfere
    (comp 12
          (%
           (let ([z (make-parameter 0)])
             (match 1
-              [(? number?) (=> f) (parameterize ([z 1]) (fcontrol 5))] 
+              [(? number?) (=> f) (parameterize ([z 1]) (fcontrol 5))]
               [(? number?) (z)]))
           (lambda _ 12)))
 
@@ -611,7 +611,7 @@
 	 (match 3
 	  [(or) 1]
 	  [_ 4]))
-   
+
    (comp '((1 2) 3)
          (match `(begin 1 2 3)
            [`(begin ,es ... ,en)
@@ -619,14 +619,14 @@
 
    (comp '(a b c)
 	 (let ()
-	   
+
 	   (define-struct foo (a b c) #:prefab)
 	   (match (make-foo 'a 'b 'c)
 		  [`#s(foo ,x ,y ,z)
 		   (list x y z)])))
    (comp '(a b c)
 	 (let ()
-	   
+
 	   (define-struct foo (a b c) #:prefab)
 	   (define-struct (bar foo) (d) #:prefab)
 	   (match (make-bar 'a 'b 'c 1)
@@ -639,11 +639,11 @@
              ([x _double*]
               [y _double*]
               [a _double*]))
-           
+
            (match (make-pose 1 2 3)
              [(struct pose (x y a)) "Gotcha!"]
              [else "Epic fail!"])))
-   
+
    (comp #f
          (match (list 'a 'b 'c)
            [(or (list a b)
@@ -653,17 +653,17 @@
                          (list a))))
             #t]
            [_ #f]))
-   
+
    (comp '(2 7)
          (let ()
            (define-match-expander foo
              (syntax-rules () [(_) 1])
-             (syntax-id-rules (set!) 
+             (syntax-id-rules (set!)
                [(set! _ v) v]
                [(_) 2]))
            (list (foo)
                  (set! foo 7))))
-   
+
    (comp 0
          (let ()
            (define-match-expander foo
@@ -672,4 +672,35 @@
              [(foo) 0]
              [_ 1])))
 
+   (comp '(1 2 4)
+         (call-with-values
+           (λ () (match-let-values ([(x y) (values 1 2)] [(3 w) (values 3 4)])
+                   (values x y w)))
+           list))
+
+   (comp '(1 3 4)
+         (call-with-values
+           (λ () (match-let*-values ([(x y) (values 1 2)] [(y w) (values 3 4)])
+                   (values x y w)))
+           list))
+
+   (comp '(1 2 3)
+         (match/values (values 1 2 3)
+           [(x y z) (list x y z)]))
+
+   (comp '(1 2)
+         (let () (match-define-values (x y 3) (values 1 2 3))
+              (list x y)))
+
+   (comp '(1 2 3)
+         (match-let ([(list x y) (list 1 2)] [(list y z) '(2 3)])
+            (list x y z)))
+
+   (comp 'yes
+         (with-handlers ([exn:fail? (lambda _ 'yes)]
+                         [values (lambda _ 'no)])
+           (match-let ([(list x y) (list 1 22)] [(list y z) '(2 3)])
+                      (list x y z))))
+
+
 ))
diff --git a/collects/tests/racket/benchmarks/common/typed/wrapper.rkt b/collects/tests/racket/benchmarks/common/typed/wrapper.rkt
index 5e01b69697..13ab05fafa 100644
--- a/collects/tests/racket/benchmarks/common/typed/wrapper.rkt
+++ b/collects/tests/racket/benchmarks/common/typed/wrapper.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 (provide (rename-out (module-begin #%module-begin)))
 (require (prefix-in ts: typed/racket/base)
-         (for-syntax racket/base (prefix-in r: typed-scheme/typed-reader))
+         (for-syntax racket/base (prefix-in r: typed-racket/typed-reader))
          racket/include typed/racket/base racket/file)
 
 (define-syntax (module-begin stx)
diff --git a/collects/tests/racket/benchmarks/shootout/typed/wrapper.rkt b/collects/tests/racket/benchmarks/shootout/typed/wrapper.rkt
index 28347c36c1..10f3fa5b9d 100644
--- a/collects/tests/racket/benchmarks/shootout/typed/wrapper.rkt
+++ b/collects/tests/racket/benchmarks/shootout/typed/wrapper.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 (provide (rename-out (module-begin #%module-begin)))
 (require (prefix-in ts: typed/scheme/base)
-	 (for-syntax racket/base (prefix-in r: typed-scheme/typed-reader))
+	 (for-syntax racket/base (prefix-in r: typed-racket/typed-reader))
 	 racket/include typed/scheme/base)
 
 (define-syntax (module-begin stx)
diff --git a/collects/tests/racket/cm.rktl b/collects/tests/racket/cm.rktl
index 036c985649..d199588e0b 100644
--- a/collects/tests/racket/cm.rktl
+++ b/collects/tests/racket/cm.rktl
@@ -146,6 +146,82 @@
     (parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)])
       (test (void) dynamic-require 'compiler/cm #f))))
 
+;; ----------------------------------------
+;; test for make-compile-lock
+
+(let ()
+  #|
+  
+This test creates a file to compile that, during compilation, conditionally
+freezes forever. It first creates a thread to compile the file in freeze-forever
+mode, and then, when the thread is stuck, creates a second thread to compile
+the file and kills the first thread. The second compile should complete properly
+and the test makes sure that it does and that the first thread doesn't complete.
+
+  |#
+  
+  (define (sexps=>file file #:lang [lang #f] . sexps)
+    (call-with-output-file file 
+      (λ (port)
+        (when lang (fprintf port "~a\n" lang))
+        (for ([x (in-list sexps)]) (fprintf port "~s\n" x)))
+      #:exists 'truncate))
+
+  (define (poll-file file for)
+    (let loop ([n 100])
+      (when (zero? n)
+        (error 'compiler/cm::poll-file "never found ~s in ~s" for file))
+      (define now (call-with-input-file file (λ (port) (read-line port))))
+      (unless (equal? now for)
+        (sleep .1)
+        (loop (- n 1)))))
+  
+  (define file-to-compile (make-temporary-file "cmtest-file-to-compile~a.rkt"))
+  (define control-file (make-temporary-file "cmtest-control-file-~a.rktd"))
+  (define about-to-get-stuck-file (make-temporary-file "cmtest-about-to-get-stuck-file-~a.rktd"))
+  
+  (sexps=>file file-to-compile #:lang "#lang racket"
+               `(define-syntax (m stx)
+                  (call-with-output-file ,(path->string about-to-get-stuck-file) 
+                    (λ (port) (fprintf port "about\n"))
+                    #:exists 'truncate)
+                  (if (call-with-input-file ,(path->string control-file) read)
+                      (semaphore-wait (make-semaphore 0))
+                      #'1))
+               '(void (m)))
+  (sexps=>file control-file #t)
+  
+  (define p-l-c (compile-lock->parallel-lock-client (make-compile-lock) (current-custodian)))
+  (define t1-finished? #f)
+  (parameterize ([parallel-lock-client p-l-c]
+                 [current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)])
+    (define finished (make-channel))
+    (define t1 (thread (λ () (dynamic-require file-to-compile #f) (set! t1-finished? #t))))
+    (poll-file about-to-get-stuck-file "about")
+    (sexps=>file control-file #f)
+    (define t2 (thread (λ () (dynamic-require file-to-compile #f) (channel-put finished #t))))
+    (sleep .1) ;; give thread t2 time to get stuck waiting for t1 to compile
+    (kill-thread t1)
+    (channel-get finished)
+
+    (test #f 't1-finished? t1-finished?)
+    
+    (test #t 
+          'compile-lock::compiled-file-exists
+          (file-exists?
+           (let-values ([(base name dir?) (split-path file-to-compile)])
+             (build-path base 
+                         "compiled" 
+                         (bytes->path (regexp-replace #rx"[.]rkt" (path->bytes name) "_rkt.zo"))))))
+    
+    (define compiled-dir
+      (let-values ([(base name dir?) (split-path file-to-compile)])
+        (build-path base "compiled")))
+    (delete-file file-to-compile)
+    (delete-file control-file)
+    (delete-file about-to-get-stuck-file)
+    (delete-directory/files compiled-dir)))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/collects/tests/racket/module.rktl b/collects/tests/racket/module.rktl
index f17c36a7bd..b8e99d6352 100644
--- a/collects/tests/racket/module.rktl
+++ b/collects/tests/racket/module.rktl
@@ -194,6 +194,40 @@
 	(eval `(require 'f))
 	(test (list* 'd 'b finished) values l)))))
 
+(let* ([n (make-base-namespace)]
+       [l null]
+       [here (lambda (v)
+	       (set! l (cons v l)))])
+  (parameterize ([current-namespace n])
+    (eval `(module a racket/base
+             (require (for-syntax racket/base)
+                      (for-meta 2 racket/base))
+	     (define a 1)
+             (define-syntax (a-macro stx) #'-1)
+             (begin-for-syntax
+              (,here 'pma))
+             (begin-for-syntax
+              (,here 'ma)
+              (define a-meta 10)
+              (define-syntax (a-meta-macro stx) #'-1)
+              (begin-for-syntax
+               (define a-meta-meta 100)
+               (,here 'mma)))
+	     (,here 'a)
+	     (provide a a-macro (for-syntax a-meta-macro))))
+    (test '(ma mma pma) values l)
+    (set! l null)
+    (dynamic-require ''a #f)
+    (test '(a) values l)
+    (eval `10)
+    (test '(a) values l)
+    (dynamic-require ''a 0) ; => 'a is available...
+    (eval `10)
+    (test '(ma pma a) values l)
+    (eval '(begin-for-syntax)) ; triggers phase-1 visit => phase-2 instantiate
+    (test '(mma ma pma a) values l)
+    (void)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check redundant import and re-provide
 
diff --git a/collects/tests/racket/place-channel-fd.rkt b/collects/tests/racket/place-channel-fd.rkt
index 1218437138..d8a6fa3db4 100644
--- a/collects/tests/racket/place-channel-fd.rkt
+++ b/collects/tests/racket/place-channel-fd.rkt
@@ -4,6 +4,8 @@
          racket/port
          racket/runtime-path
          racket/list
+         racket/tcp
+         racket/match
          rackunit
          (for-syntax racket/base))
 
@@ -84,4 +86,29 @@
   (define i3 (open-input-file "test2"))
   (check-equal? #t #t "cleanup of unreceived port message")
   (place-channel-put p i3)
+
+
+  (define port-ch (make-channel))
+  
+  (thread 
+    (lambda () 
+      (define p (place ch
+                            (match (place-channel-get ch)
+                              [(list in out)
+                                (define x (read in))
+                                (printf "IN PLACE ~a\n" x)
+                                (write (string-append "From Place " x) out)
+                                (flush-output out)])))
+      (define s (tcp-listen 0))
+      (define-values (h1 p1 h2 p2) (tcp-addresses s #t))
+      (printf "~a ~a ~a ~a\n" h1 p1 h2 p2)
+      (channel-put port-ch p1)
+      (define-values (in out) (tcp-accept s))
+      (place-channel-put p (list in out))
+      (place-wait p)))
+
+  (define-values (in out) (tcp-connect "localhost" (channel-get port-ch)))
+  (write "Hello There" out)
+  (flush-output out)
+  (displayln (read in))
   )
diff --git a/collects/tests/racket/place-channel-fd2.rkt b/collects/tests/racket/place-channel-fd2.rkt
new file mode 100644
index 0000000000..aadd042ee1
--- /dev/null
+++ b/collects/tests/racket/place-channel-fd2.rkt
@@ -0,0 +1,68 @@
+#lang racket/base
+(require racket/match
+         racket/place
+         rackunit)
+
+(define (racket-subprocess o i e . args)
+  (define (current-executable-path)
+    (parameterize ([current-directory (find-system-path 'orig-dir)])
+      (find-executable-path (find-system-path 'exec-file) #f)))
+
+  (apply subprocess o i e (current-executable-path) args))
+
+(provide main)
+(define (main)
+  (test-case
+    "test file descriptors copied across place channesl"
+;; write out "fdt.rkt"
+    (with-output-to-file "fdt.rkt" #:exists 'replace (lambda ()
+      (display
+#<<END
+#lang racket/base
+(define (write-flush x [p (current-output-port)])
+  (write x p)
+  (flush-output p))
+
+(sleep 3)
+(with-handlers ([exn? (lambda (e) (eprintf "Child Read1 Exception Caught ~e\n" e))])
+  (define r (read))
+  (log-debug (format "Child Read1 ~a\n" r)))
+(with-handlers ([exn? (lambda (e) (eprintf "Child Read2 Exception Caught ~e\n" e))])
+  (define r (read))
+  (log-debug (format "Child Read2 ~a\n" r)))
+;(close-input-port)
+
+(sleep 3)
+(with-handlers ([exn? (lambda (e) (eprintf "Child Write StdOut Exception Caught ~e\n" e))])
+  (write-flush "ByeO"))
+(with-handlers ([exn? (lambda (e) (eprintf "Child Write StdErr Exception Caught ~e\n" e))])
+  (log-debug "ByeE"))
+END
+)))
+
+    (define (write-flush x [port (current-output-port)])
+      (write x port)
+      (flush-output port))
+
+    (define p
+      (place ch
+        (match (place-channel-get ch)
+          [(list in out)
+           (with-handlers ([exn? (lambda (e) (printf "Place Write Exception Caught ~e\n" e) (raise e))])
+             (write "BFrom Place" out)
+             (flush-output out))
+             (close-output-port out)])))
+
+    (let ()
+      (define-values (s o i e) (racket-subprocess #f #f (current-error-port) "fdt.rkt"))
+      (place-channel-put p (list o i))
+      ;(close-output-port i)
+      ;(close-input-port o)
+      (place-wait p)
+      (with-handlers ([exn? (lambda (e) (printf "Parent Write Exception Caught ~e\n" e) (raise e))])
+        (write-flush "AFrom Parent" i))
+      (with-handlers ([exn? (lambda (e) (printf "Parent Read Exception Caught ~e\n" e) (raise e))])
+        (printf "ParentRead ~v\n" (read o)))
+      (subprocess-wait s)
+      (displayln (subprocess-status s)))))
+
diff --git a/collects/tests/racket/place-channel-socket.rkt b/collects/tests/racket/place-channel-socket.rkt
new file mode 100644
index 0000000000..e1da280b7b
--- /dev/null
+++ b/collects/tests/racket/place-channel-socket.rkt
@@ -0,0 +1,58 @@
+#lang racket/base
+(require racket/match
+         racket/place
+         racket/tcp
+         rackunit)
+
+(provide main)
+
+(define (main)
+  (test-case
+    "places use of scheme_socket_to_ports abandons ports correctly"
+    (define port-ch (make-channel))
+
+    (define p 
+      (place ch
+        (match (place-channel-get ch)
+          [(list in out)
+            (printf "IN PLACE\n")
+            (with-handlers ([exn? (lambda (e) (printf "Place Write Exception Caught ~e\n" e) (raise e))])
+              (write "From Place" out)
+              (flush-output out))
+              ;(sleep 12)
+            (tcp-abandon-port in)
+            (tcp-abandon-port out)
+            ])))
+
+    (define t 
+      (thread
+        (lambda ()
+
+          (define s (tcp-listen 0))
+          (define-values (h1 p1 h2 p2) (tcp-addresses s #t))
+          (printf "~a ~a ~a ~a\n" h1 p1 h2 p2)
+          (channel-put port-ch p1)
+          (define-values (in out) (tcp-accept s))
+          (place-channel-put p (list in out))
+          (place-wait p)
+          ;(close-input-port in)
+          ;(close-output-port out)
+          (with-handlers ([exn? (lambda (e) (printf "Server Write Exception Caught ~e\n" e) (raise e))])
+            (write "From Server" out)
+            (flush-output out))
+          (with-handlers ([exn? (lambda (e) (printf "Server Read Exception Caught2 ~e\n" e) (raise e))])
+            (define x (read in))
+            (printf "SERVER IN ~a\n" x))
+          )))
+
+    (define-values (in out) (tcp-connect "localhost" (channel-get port-ch)))
+    (printf "Connected\n")
+    (sleep 3)
+    (with-handlers ([exn? (lambda (e) (printf "Client Write Exception Caught ~e\n" (raise e)))])
+      (write "From Client" out)
+      (flush-output out))
+    (printf "CLIENT IN1 ~a\n" (read in))
+    (printf "CLIENT IN2 ~a\n" (read in))
+    (thread-wait t)
+    (place-wait p)))
+
diff --git a/collects/tests/racket/place-channel.rkt b/collects/tests/racket/place-channel.rkt
index 14acc72cbc..45844d4751 100644
--- a/collects/tests/racket/place-channel.rkt
+++ b/collects/tests/racket/place-channel.rkt
@@ -354,29 +354,6 @@
   (test-long (lambda (x) (intern-num-sym (modulo x 1000))) "Listof symbols")
   (test-long (lambda (x) #s(clown "Binky" "pie")) "Listof prefabs")
   (test-long (lambda (x) (read (open-input-string "#0=(#0# . #0#)"))) "Listof cycles")
-
-  (define port-ch (make-channel))
-  
-  (thread 
-    (lambda () 
-      (define p (place ch
-                            (match (place-channel-get ch)
-                              [(list in out)
-                                (define x (read in))
-                                (printf "IN PLACE ~a\n" x)
-                                (write (string-append "From Place " x) out)
-                                (flush-output out)])))
-      (define s (tcp-listen 0))
-      (define-values (h1 p1 h2 p2) (tcp-addresses s #t))
-      (printf "~a ~a ~a ~a\n" h1 p1 h2 p2)
-      (channel-put port-ch p1)
-      (define-values (in out) (tcp-accept s))
-      (place-channel-put p (list in out))
-      (place-wait p)))
-
-  (define-values (in out) (tcp-connect "localhost" (channel-get port-ch)))
-  (write "Hello There" out)
-  (flush-output out)
-  (displayln (read in)))
+)
   
 ;(report-errs)
diff --git a/collects/tests/racket/place.rktl b/collects/tests/racket/place.rktl
index 87fbfbbdd3..52b4f8bff5 100644
--- a/collects/tests/racket/place.rktl
+++ b/collects/tests/racket/place.rktl
@@ -5,6 +5,7 @@
 (place-wait (place/base (p1 ch)
   (printf "Hello from place\n")))
 
+
 (let ([p (place/base (p1 ch)
           (printf "Hello form place 2\n")
           (exit 99))])
@@ -30,6 +31,8 @@
 (err/rt-test (dynamic-place "foo.rkt"))
 (err/rt-test (dynamic-place null 10))
 (err/rt-test (dynamic-place "foo.rkt" 10))
+(err/rt-test (dynamic-place '(quote some-module) 'tfunc))
+
         
 (let ([p (place/base (p1 ch)
           (printf "Hello form place 2\n")
diff --git a/collects/tests/racket/runaway-place.rkt b/collects/tests/racket/runaway-place.rkt
new file mode 100644
index 0000000000..f16584b69c
--- /dev/null
+++ b/collects/tests/racket/runaway-place.rkt
@@ -0,0 +1,16 @@
+#lang racket/base
+(require racket/place)
+
+(provide main runaway)
+
+(define (main)
+  (parameterize ([current-custodian (make-custodian)])
+    (custodian-limit-memory (current-custodian) (* 1024 1024 64))
+    (parameterize ([current-custodian (make-custodian)])
+      (place-wait (place ch (runaway))))))
+
+(define (runaway)
+  (printf "starting\n")
+  (define p (place ch (runaway)))
+  (place-wait p))
+
diff --git a/collects/tests/racket/subprocess.rktl b/collects/tests/racket/subprocess.rktl
index 87ee144ac3..4ef1d5e63c 100644
--- a/collects/tests/racket/subprocess.rktl
+++ b/collects/tests/racket/subprocess.rktl
@@ -413,15 +413,13 @@
                                 "-e"
                                 "(let loop () (loop))"))]
                  [running? (lambda (sub-pid)
-                             (equal?
-                              (list (number->string sub-pid))
-                              (regexp-match
-                               (format "(?m:^ *~a(?=[^0-9]))" sub-pid)
-                               (let ([s (open-output-string)])
-                                 (parameterize ([current-output-port s]
-                                                [current-input-port (open-input-string "")])
-                                   (system (format "ps x")))
-                                 (get-output-string s)))))])
+                             (regexp-match?
+                              (format "(?m:^ *~a(?=[^0-9]))" sub-pid)
+                              (let ([s (open-output-string)])
+                                (parameterize ([current-output-port s]
+                                               [current-input-port (open-input-string "")])
+                                  (system (format "ps x")))
+                                (get-output-string s))))])
              (let ([sub-pid (read (car l))])
                (test 'running (list-ref l 4) 'status)
                (test #t running? sub-pid)
@@ -436,6 +434,13 @@
     (try #f)))
   
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check status result
+
+(unless (eq? (system-type) 'windows)
+  (parameterize ([current-input-port (open-input-string "")])
+    (test 3 system/exit-code "exit 3")))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)
diff --git a/collects/tests/run-automated-tests.rkt b/collects/tests/run-automated-tests.rkt
index 3b8abb9419..5615e8eacb 100755
--- a/collects/tests/run-automated-tests.rkt
+++ b/collects/tests/run-automated-tests.rkt
@@ -33,7 +33,7 @@
         ;; that expect to get (lib "racket/init") as a result.
         #:additional-modules '((lib "racket/init")))
   ;; (test "planet/lang.rkt")
-  (test "typed-scheme/nightly-run.rkt" #:timeout 25)
+  (test "typed-racket/nightly-run.rkt" #:timeout 25)
   (test "match/plt-match-tests.rkt")
   ;; (test "stepper/automatic-tests.rkt" #:additional-modules (scheme/base))
   (test "lazy/main.rkt")
diff --git a/collects/tests/srfi/11/srfi-11-test.rkt b/collects/tests/srfi/11/srfi-11-test.rkt
new file mode 100644
index 0000000000..9d5c69996e
--- /dev/null
+++ b/collects/tests/srfi/11/srfi-11-test.rkt
@@ -0,0 +1,9 @@
+#lang racket/base
+
+(require srfi/11 rackunit)
+(provide srfi-11-tests)
+
+(define srfi-11-tests
+  (test-suite
+   "Tests for SRFI 11"
+   (check-equal? (let-values ((x (values 1 2 3))) x) '(1 2 3) "PR 12147")))
diff --git a/collects/tests/srfi/all-srfi-tests.rkt b/collects/tests/srfi/all-srfi-tests.rkt
index 12933bf9cd..8c171119d6 100644
--- a/collects/tests/srfi/all-srfi-tests.rkt
+++ b/collects/tests/srfi/all-srfi-tests.rkt
@@ -1,28 +1,28 @@
-(module all-srfi-tests mzscheme
-  
-  (require rackunit)
-  (require "1/all-1-tests.rkt"
-           "2/and-let-test.rkt"
-           "4/srfi-4-test.rkt"
-           "13/string-test.rkt"
-           "14/char-set-test.rkt"
-           "26/cut-test.rkt"
-           "40/all-srfi-40-tests.rkt"
-           "43/all-srfi-43-tests.rkt"
-           "69/hash-tests.rkt")
-  (provide all-srfi-tests)
-  
-  (define all-srfi-tests
-    (test-suite 
-     "all-srfi-tests"
-     all-1-tests
-     and-let*-tests
-     string-tests
-     char-set-tests
-     cut-tests
-     all-srfi-40-tests
-     all-srfi-43-tests
-     hash-tests
-     srfi-4-tests
-     ))
-  )
+#lang racket/base
+(require rackunit)
+(require "1/all-1-tests.rkt"
+         "2/and-let-test.rkt"
+         "4/srfi-4-test.rkt"
+         "11/srfi-11-test.rkt"
+         "13/string-test.rkt"
+         "14/char-set-test.rkt"
+         "26/cut-test.rkt"
+         "40/all-srfi-40-tests.rkt"
+         "43/all-srfi-43-tests.rkt"
+         "69/hash-tests.rkt")
+(provide all-srfi-tests)
+
+(define all-srfi-tests
+  (test-suite
+   "all-srfi-tests"
+   all-1-tests
+   and-let*-tests
+   string-tests
+   char-set-tests
+   cut-tests
+   all-srfi-40-tests
+   all-srfi-43-tests
+   hash-tests
+   srfi-4-tests
+   srfi-11-tests
+   ))
diff --git a/collects/tests/srfi/load-srfis.rktl b/collects/tests/srfi/load-srfis.rktl
index 26c7bf11b8..011e9344fe 100644
--- a/collects/tests/srfi/load-srfis.rktl
+++ b/collects/tests/srfi/load-srfis.rktl
@@ -10,6 +10,7 @@
 (require srfi/7)
 (require srfi/8)
 (require srfi/9)
+(require srfi/11)
 (require srfi/13)
 (require srfi/14)
 (require srfi/17)
diff --git a/collects/tests/syntax/mzstruct.rkt b/collects/tests/syntax/mzstruct.rkt
new file mode 100644
index 0000000000..c66db445cf
--- /dev/null
+++ b/collects/tests/syntax/mzstruct.rkt
@@ -0,0 +1,29 @@
+#lang mzscheme
+(require (for-syntax syntax/struct))
+
+;; Like the "struct.rkt", but checks that it works in the
+;;  `mzscheme' language, still
+
+(define-syntax (exp stx)
+  (syntax-case stx ()
+    [(_ sel? set? (name sup) (field ...))
+     (with-syntax ([e (build-struct-generation #'name
+                                               (syntax->list #'(field ...))
+                                               (not (syntax-e #'sel?))
+                                               (not (syntax-e #'set?))
+                                               (and (syntax-e #'sup) #'sup))]
+                   [(id ...)
+                    (build-struct-names #'name
+                                        (syntax->list #'(field ...))
+                                        (not (syntax-e #'sel?))
+                                        (not (syntax-e #'set?)))])
+       #'(define-values (id ...) e))]))
+
+(define (check a b)
+  (unless (equal? a b) (error "failed!")))
+
+(let ([set-pt-x! 12])
+  (exp #t #t (pt #f) (x y))
+  (check 10 (pt-x (make-pt 10 20)))
+  (check 20 (pt-y (make-pt 10 20)))
+  (check #t (procedure? set-pt-x!)))
diff --git a/collects/tests/syntax/struct.rkt b/collects/tests/syntax/struct.rkt
new file mode 100644
index 0000000000..c9d15c1a38
--- /dev/null
+++ b/collects/tests/syntax/struct.rkt
@@ -0,0 +1,32 @@
+#lang racket
+(require (for-syntax syntax/struct))
+
+(define-syntax (exp stx)
+  (syntax-case stx ()
+    [(_ sel? set? (name sup) (field ...))
+     (with-syntax ([e (build-struct-generation #'name
+                                               (syntax->list #'(field ...))
+                                               (not (syntax-e #'sel?))
+                                               (not (syntax-e #'set?))
+                                               (and (syntax-e #'sup) #'sup))]
+                   [(id ...)
+                    (build-struct-names #'name
+                                        (syntax->list #'(field ...))
+                                        (not (syntax-e #'sel?))
+                                        (not (syntax-e #'set?)))])
+       #'(define-values (id ...) e))]))
+
+(define (check a b)
+  (unless (equal? a b) (error "failed!")))
+
+(let ([set-pt-x! 12])
+  (exp #t #f (pt #f) (x y))
+  (check 10 (pt-x (make-pt 10 20)))
+  (check 20 (pt-y (make-pt 10 20)))
+  (check 12 set-pt-x!))
+
+(let ([set-pt-x! 12])
+  (exp #t #t (pt #f) (x y))
+  (check 10 (pt-x (make-pt 10 20)))
+  (check 20 (pt-y (make-pt 10 20)))
+  (check #t (procedure? set-pt-x!)))
diff --git a/collects/tests/typed-scheme/fail/all-bad-syntax.rkt b/collects/tests/typed-racket/fail/all-bad-syntax.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/all-bad-syntax.rkt
rename to collects/tests/typed-racket/fail/all-bad-syntax.rkt
diff --git a/collects/tests/typed-scheme/fail/ann-map-funcs.rkt b/collects/tests/typed-racket/fail/ann-map-funcs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/ann-map-funcs.rkt
rename to collects/tests/typed-racket/fail/ann-map-funcs.rkt
diff --git a/collects/tests/typed-scheme/fail/apply-dots.rkt b/collects/tests/typed-racket/fail/apply-dots.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/apply-dots.rkt
rename to collects/tests/typed-racket/fail/apply-dots.rkt
diff --git a/collects/tests/typed-scheme/fail/back-and-forth.rkt b/collects/tests/typed-racket/fail/back-and-forth.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/back-and-forth.rkt
rename to collects/tests/typed-racket/fail/back-and-forth.rkt
diff --git a/collects/tests/typed-scheme/fail/bad-ann.rkt b/collects/tests/typed-racket/fail/bad-ann.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/bad-ann.rkt
rename to collects/tests/typed-racket/fail/bad-ann.rkt
diff --git a/collects/tests/typed-scheme/fail/bad-any.rkt b/collects/tests/typed-racket/fail/bad-any.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/bad-any.rkt
rename to collects/tests/typed-racket/fail/bad-any.rkt
diff --git a/collects/tests/typed-scheme/fail/bad-first.rkt b/collects/tests/typed-racket/fail/bad-first.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/bad-first.rkt
rename to collects/tests/typed-racket/fail/bad-first.rkt
diff --git a/collects/tests/typed-scheme/fail/bad-hash-ref.rkt b/collects/tests/typed-racket/fail/bad-hash-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/bad-hash-ref.rkt
rename to collects/tests/typed-racket/fail/bad-hash-ref.rkt
diff --git a/collects/tests/typed-scheme/fail/bad-map-poly.rkt b/collects/tests/typed-racket/fail/bad-map-poly.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/bad-map-poly.rkt
rename to collects/tests/typed-racket/fail/bad-map-poly.rkt
diff --git a/collects/tests/typed-scheme/fail/bad-type-app.rkt b/collects/tests/typed-racket/fail/bad-type-app.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/bad-type-app.rkt
rename to collects/tests/typed-racket/fail/bad-type-app.rkt
diff --git a/collects/tests/typed-scheme/fail/box-fail.rkt b/collects/tests/typed-racket/fail/box-fail.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/box-fail.rkt
rename to collects/tests/typed-racket/fail/box-fail.rkt
diff --git a/collects/tests/typed-scheme/fail/check-expect-fail.rkt b/collects/tests/typed-racket/fail/check-expect-fail.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/check-expect-fail.rkt
rename to collects/tests/typed-racket/fail/check-expect-fail.rkt
diff --git a/collects/tests/typed-scheme/fail/cl-bug.rkt b/collects/tests/typed-racket/fail/cl-bug.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/cl-bug.rkt
rename to collects/tests/typed-racket/fail/cl-bug.rkt
diff --git a/collects/tests/typed-scheme/fail/cnt-err1.rkt b/collects/tests/typed-racket/fail/cnt-err1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/cnt-err1.rkt
rename to collects/tests/typed-racket/fail/cnt-err1.rkt
diff --git a/collects/tests/typed-scheme/fail/cnt-struct-err.rkt b/collects/tests/typed-racket/fail/cnt-struct-err.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/cnt-struct-err.rkt
rename to collects/tests/typed-racket/fail/cnt-struct-err.rkt
diff --git a/collects/tests/typed-scheme/fail/dead-substruct.rkt b/collects/tests/typed-racket/fail/dead-substruct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/dead-substruct.rkt
rename to collects/tests/typed-racket/fail/dead-substruct.rkt
diff --git a/collects/tests/typed-scheme/fail/dup-ann.rkt b/collects/tests/typed-racket/fail/dup-ann.rkt
similarity index 95%
rename from collects/tests/typed-scheme/fail/dup-ann.rkt
rename to collects/tests/typed-racket/fail/dup-ann.rkt
index 84b89f0cd8..7fd2210082 100644
--- a/collects/tests/typed-scheme/fail/dup-ann.rkt
+++ b/collects/tests/typed-racket/fail/dup-ann.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred 4)
+(exn-pred 2)
 #lang typed/racket
 (: bar : (String -> String))
 (: bar : (Number -> Number))
diff --git a/collects/tests/typed-scheme/fail/duplicate-ann.rkt b/collects/tests/typed-racket/fail/duplicate-ann.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/duplicate-ann.rkt
rename to collects/tests/typed-racket/fail/duplicate-ann.rkt
diff --git a/collects/tests/typed-scheme/fail/formal-len-mismatches.rkt b/collects/tests/typed-racket/fail/formal-len-mismatches.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/formal-len-mismatches.rkt
rename to collects/tests/typed-racket/fail/formal-len-mismatches.rkt
diff --git a/collects/tests/typed-scheme/fail/gadt.rkt b/collects/tests/typed-racket/fail/gadt.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/gadt.rkt
rename to collects/tests/typed-racket/fail/gadt.rkt
diff --git a/collects/tests/typed-scheme/fail/ht-infer.rkt b/collects/tests/typed-racket/fail/ht-infer.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/ht-infer.rkt
rename to collects/tests/typed-racket/fail/ht-infer.rkt
diff --git a/collects/tests/typed-scheme/fail/inexact-complex.rkt b/collects/tests/typed-racket/fail/inexact-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/inexact-complex.rkt
rename to collects/tests/typed-racket/fail/inexact-complex.rkt
diff --git a/collects/tests/typed-scheme/fail/infer-dots.rkt b/collects/tests/typed-racket/fail/infer-dots.rkt
similarity index 86%
rename from collects/tests/typed-scheme/fail/infer-dots.rkt
rename to collects/tests/typed-racket/fail/infer-dots.rkt
index b7ae503a39..04af012527 100644
--- a/collects/tests/typed-scheme/fail/infer-dots.rkt
+++ b/collects/tests/typed-racket/fail/infer-dots.rkt
@@ -1,6 +1,6 @@
 #lang typed-scheme
 
-(require typed-scheme/base-env/extra-procs)
+(require typed-racket/base-env/extra-procs)
 
 (map + (list 1 2 3) (list 10 20 30) (list 'a 'b 'c))
 
diff --git a/collects/tests/typed-scheme/fail/internal-ann.rkt b/collects/tests/typed-racket/fail/internal-ann.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/internal-ann.rkt
rename to collects/tests/typed-racket/fail/internal-ann.rkt
diff --git a/collects/tests/typed-scheme/fail/log-not-complex.rkt b/collects/tests/typed-racket/fail/log-not-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/log-not-complex.rkt
rename to collects/tests/typed-racket/fail/log-not-complex.rkt
diff --git a/collects/tests/typed-scheme/fail/nested-tvars.rkt b/collects/tests/typed-racket/fail/nested-tvars.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/nested-tvars.rkt
rename to collects/tests/typed-racket/fail/nested-tvars.rkt
diff --git a/collects/tests/typed-scheme/fail/nonnegative-float.rkt b/collects/tests/typed-racket/fail/nonnegative-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/nonnegative-float.rkt
rename to collects/tests/typed-racket/fail/nonnegative-float.rkt
diff --git a/collects/tests/typed-scheme/fail/poly-expect-error.rkt b/collects/tests/typed-racket/fail/poly-expect-error.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/poly-expect-error.rkt
rename to collects/tests/typed-racket/fail/poly-expect-error.rkt
diff --git a/collects/tests/typed-scheme/fail/port-to-list.rkt b/collects/tests/typed-racket/fail/port-to-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/port-to-list.rkt
rename to collects/tests/typed-racket/fail/port-to-list.rkt
diff --git a/collects/tests/typed-scheme/fail/pr10350.rkt b/collects/tests/typed-racket/fail/pr10350.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/pr10350.rkt
rename to collects/tests/typed-racket/fail/pr10350.rkt
diff --git a/collects/tests/typed-scheme/fail/pr10594.rkt b/collects/tests/typed-racket/fail/pr10594.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/pr10594.rkt
rename to collects/tests/typed-racket/fail/pr10594.rkt
diff --git a/collects/tests/typed-scheme/fail/pr11560.rkt b/collects/tests/typed-racket/fail/pr11560.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/pr11560.rkt
rename to collects/tests/typed-racket/fail/pr11560.rkt
diff --git a/collects/tests/typed-scheme/fail/pr11686.rkt b/collects/tests/typed-racket/fail/pr11686.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/pr11686.rkt
rename to collects/tests/typed-racket/fail/pr11686.rkt
diff --git a/collects/tests/typed-scheme/fail/pr11772.rkt b/collects/tests/typed-racket/fail/pr11772.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/pr11772.rkt
rename to collects/tests/typed-racket/fail/pr11772.rkt
diff --git a/collects/tests/typed-scheme/fail/pr11998.rkt b/collects/tests/typed-racket/fail/pr11998.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/pr11998.rkt
rename to collects/tests/typed-racket/fail/pr11998.rkt
diff --git a/collects/tests/typed-scheme/fail/require-typed-missing.rkt b/collects/tests/typed-racket/fail/require-typed-missing.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/require-typed-missing.rkt
rename to collects/tests/typed-racket/fail/require-typed-missing.rkt
diff --git a/collects/tests/typed-scheme/fail/require-typed-wrong.rkt b/collects/tests/typed-racket/fail/require-typed-wrong.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/require-typed-wrong.rkt
rename to collects/tests/typed-racket/fail/require-typed-wrong.rkt
diff --git a/collects/tests/typed-scheme/fail/reverse-special.rkt b/collects/tests/typed-racket/fail/reverse-special.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/reverse-special.rkt
rename to collects/tests/typed-racket/fail/reverse-special.rkt
diff --git a/collects/tests/typed-scheme/fail/rts-prov.rkt b/collects/tests/typed-racket/fail/rts-prov.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/rts-prov.rkt
rename to collects/tests/typed-racket/fail/rts-prov.rkt
diff --git a/collects/tests/typed-scheme/fail/safe-letrec.rkt b/collects/tests/typed-racket/fail/safe-letrec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/safe-letrec.rkt
rename to collects/tests/typed-racket/fail/safe-letrec.rkt
diff --git a/collects/tests/typed-scheme/fail/set-struct.rkt b/collects/tests/typed-racket/fail/set-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/set-struct.rkt
rename to collects/tests/typed-racket/fail/set-struct.rkt
diff --git a/collects/tests/typed-scheme/fail/set-tests.rkt b/collects/tests/typed-racket/fail/set-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/set-tests.rkt
rename to collects/tests/typed-racket/fail/set-tests.rkt
diff --git a/collects/tests/typed-scheme/fail/sort.rkt b/collects/tests/typed-racket/fail/sort.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/sort.rkt
rename to collects/tests/typed-racket/fail/sort.rkt
diff --git a/collects/tests/typed-scheme/fail/struct-provide.rkt b/collects/tests/typed-racket/fail/struct-provide.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/struct-provide.rkt
rename to collects/tests/typed-racket/fail/struct-provide.rkt
diff --git a/collects/tests/typed-scheme/fail/subtype-int-err.rkt b/collects/tests/typed-racket/fail/subtype-int-err.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/subtype-int-err.rkt
rename to collects/tests/typed-racket/fail/subtype-int-err.rkt
diff --git a/collects/tests/typed-scheme/fail/tc-error-format.rkt b/collects/tests/typed-racket/fail/tc-error-format.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/tc-error-format.rkt
rename to collects/tests/typed-racket/fail/tc-error-format.rkt
diff --git a/collects/tests/typed-scheme/fail/too-many-errors.rkt b/collects/tests/typed-racket/fail/too-many-errors.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/too-many-errors.rkt
rename to collects/tests/typed-racket/fail/too-many-errors.rkt
diff --git a/collects/tests/typed-scheme/fail/unbound-non-reg.rkt b/collects/tests/typed-racket/fail/unbound-non-reg.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/unbound-non-reg.rkt
rename to collects/tests/typed-racket/fail/unbound-non-reg.rkt
diff --git a/collects/tests/typed-scheme/fail/unbound-type.rkt b/collects/tests/typed-racket/fail/unbound-type.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/unbound-type.rkt
rename to collects/tests/typed-racket/fail/unbound-type.rkt
diff --git a/collects/tests/typed-scheme/fail/undefined.rkt b/collects/tests/typed-racket/fail/undefined.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/undefined.rkt
rename to collects/tests/typed-racket/fail/undefined.rkt
diff --git a/collects/tests/typed-scheme/fail/unsafe-struct-parent.rkt b/collects/tests/typed-racket/fail/unsafe-struct-parent.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/unsafe-struct-parent.rkt
rename to collects/tests/typed-racket/fail/unsafe-struct-parent.rkt
diff --git a/collects/tests/typed-scheme/fail/unsafe-struct.rkt b/collects/tests/typed-racket/fail/unsafe-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/unsafe-struct.rkt
rename to collects/tests/typed-racket/fail/unsafe-struct.rkt
diff --git a/collects/tests/typed-scheme/fail/untyped-srfi1.rkt b/collects/tests/typed-racket/fail/untyped-srfi1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/untyped-srfi1.rkt
rename to collects/tests/typed-racket/fail/untyped-srfi1.rkt
diff --git a/collects/tests/typed-scheme/fail/values-dots.rkt b/collects/tests/typed-racket/fail/values-dots.rkt
similarity index 93%
rename from collects/tests/typed-scheme/fail/values-dots.rkt
rename to collects/tests/typed-racket/fail/values-dots.rkt
index f3166c16aa..9ef8a78abf 100644
--- a/collects/tests/typed-scheme/fail/values-dots.rkt
+++ b/collects/tests/typed-racket/fail/values-dots.rkt
@@ -2,7 +2,7 @@
 (exn-pred 10)
 #lang typed-scheme
 
-(require typed-scheme/base-env/extra-procs)
+(require typed-racket/base-env/extra-procs)
 
 (: map-with-funcs (All (b ...) ((b ... b -> b) ... b -> (b ... b -> (values b ... b)))))
 (define (map-with-funcs . fs)
diff --git a/collects/tests/typed-scheme/fail/with-asserts.rkt b/collects/tests/typed-racket/fail/with-asserts.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-asserts.rkt
rename to collects/tests/typed-racket/fail/with-asserts.rkt
diff --git a/collects/tests/typed-scheme/fail/with-asserts2.rkt b/collects/tests/typed-racket/fail/with-asserts2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-asserts2.rkt
rename to collects/tests/typed-racket/fail/with-asserts2.rkt
diff --git a/collects/tests/typed-scheme/fail/with-asserts3.rkt b/collects/tests/typed-racket/fail/with-asserts3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-asserts3.rkt
rename to collects/tests/typed-racket/fail/with-asserts3.rkt
diff --git a/collects/tests/typed-scheme/fail/with-type-bug.rkt b/collects/tests/typed-racket/fail/with-type-bug.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-type-bug.rkt
rename to collects/tests/typed-racket/fail/with-type-bug.rkt
diff --git a/collects/tests/typed-scheme/fail/with-type1.rkt b/collects/tests/typed-racket/fail/with-type1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-type1.rkt
rename to collects/tests/typed-racket/fail/with-type1.rkt
diff --git a/collects/tests/typed-scheme/fail/with-type2.rkt b/collects/tests/typed-racket/fail/with-type2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-type2.rkt
rename to collects/tests/typed-racket/fail/with-type2.rkt
diff --git a/collects/tests/typed-scheme/fail/with-type3.rkt b/collects/tests/typed-racket/fail/with-type3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/fail/with-type3.rkt
rename to collects/tests/typed-racket/fail/with-type3.rkt
diff --git a/collects/tests/typed-scheme/info.rkt b/collects/tests/typed-racket/info.rkt
similarity index 100%
rename from collects/tests/typed-scheme/info.rkt
rename to collects/tests/typed-racket/info.rkt
diff --git a/collects/tests/typed-scheme/main.rkt b/collects/tests/typed-racket/main.rkt
similarity index 100%
rename from collects/tests/typed-scheme/main.rkt
rename to collects/tests/typed-racket/main.rkt
diff --git a/collects/tests/typed-racket/nightly-run.rkt b/collects/tests/typed-racket/nightly-run.rkt
new file mode 100644
index 0000000000..04691b9cd2
--- /dev/null
+++ b/collects/tests/typed-racket/nightly-run.rkt
@@ -0,0 +1,6 @@
+#lang racket/base
+
+(require racket/runtime-path)
+(define-runtime-path run "run.rkt")
+(parameterize ([current-command-line-arguments '#("--nightly")])
+  (dynamic-require run #f))
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/all-real.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/all-real.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/all-real.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/all-real.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/fixnum.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/fixnum.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/multi-file1.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/multi-file1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/multi-file1.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/multi-file1.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/multi-file2.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/multi-file2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/multi-file2.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/multi-file2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/multiple-irritants.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/multiple-irritants.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/multiple-irritants.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/multiple-irritants.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/nested-same-kind.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/nested-same-kind.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/pair.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/pair.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/precision-loss.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/precision-loss.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/real-in-float-expr.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/real-in-float-expr.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/real-in-float-expr.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/real-in-float-expr.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/unary-float.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/unary-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/unary-float.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/unary-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/unexpected-complex.rkt b/collects/tests/typed-racket/optimizer/missed-optimizations/unexpected-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/missed-optimizations/unexpected-complex.rkt
rename to collects/tests/typed-racket/optimizer/missed-optimizations/unexpected-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-racket/optimizer/run.rkt
similarity index 98%
rename from collects/tests/typed-scheme/optimizer/run.rkt
rename to collects/tests/typed-racket/optimizer/run.rkt
index d9060929b0..208b011392 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-racket/optimizer/run.rkt
@@ -1,7 +1,7 @@
 #lang racket
 (require racket/runtime-path
          rackunit rackunit/text-ui
-         typed-scheme/optimizer/logging)
+         typed-racket/optimizer/logging)
 
 (provide optimization-tests missed-optimization-tests
          test-opt test-missed-optimization test-file?
diff --git a/collects/tests/typed-scheme/optimizer/tests/add1.rkt b/collects/tests/typed-racket/optimizer/tests/add1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/add1.rkt
rename to collects/tests/typed-racket/optimizer/tests/add1.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt b/collects/tests/typed-racket/optimizer/tests/apply-plus.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
rename to collects/tests/typed-racket/optimizer/tests/apply-plus.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt b/collects/tests/typed-racket/optimizer/tests/begin-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/begin-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt b/collects/tests/typed-racket/optimizer/tests/binary-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
rename to collects/tests/typed-racket/optimizer/tests/binary-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt b/collects/tests/typed-racket/optimizer/tests/binary-nonzero-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
rename to collects/tests/typed-racket/optimizer/tests/binary-nonzero-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/bounds-check.rkt b/collects/tests/typed-racket/optimizer/tests/bounds-check.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/bounds-check.rkt
rename to collects/tests/typed-racket/optimizer/tests/bounds-check.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/box.rkt b/collects/tests/typed-racket/optimizer/tests/box.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/box.rkt
rename to collects/tests/typed-racket/optimizer/tests/box.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt b/collects/tests/typed-racket/optimizer/tests/cross-module-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt
rename to collects/tests/typed-racket/optimizer/tests/cross-module-struct.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt b/collects/tests/typed-racket/optimizer/tests/cross-module-struct2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
rename to collects/tests/typed-racket/optimizer/tests/cross-module-struct2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt b/collects/tests/typed-racket/optimizer/tests/dead-else.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
rename to collects/tests/typed-racket/optimizer/tests/dead-else.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt b/collects/tests/typed-racket/optimizer/tests/dead-substructs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
rename to collects/tests/typed-racket/optimizer/tests/dead-substructs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt b/collects/tests/typed-racket/optimizer/tests/dead-then.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
rename to collects/tests/typed-racket/optimizer/tests/dead-then.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt b/collects/tests/typed-racket/optimizer/tests/define-begin-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/define-begin-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt b/collects/tests/typed-racket/optimizer/tests/define-call-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/define-call-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-float.rkt b/collects/tests/typed-racket/optimizer/tests/define-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/define-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/define-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt b/collects/tests/typed-racket/optimizer/tests/define-pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
rename to collects/tests/typed-racket/optimizer/tests/define-pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt b/collects/tests/typed-racket/optimizer/tests/derived-pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
rename to collects/tests/typed-racket/optimizer/tests/derived-pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt b/collects/tests/typed-racket/optimizer/tests/derived-pair2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt
rename to collects/tests/typed-racket/optimizer/tests/derived-pair2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt b/collects/tests/typed-racket/optimizer/tests/derived-pair3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt
rename to collects/tests/typed-racket/optimizer/tests/derived-pair3.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt b/collects/tests/typed-racket/optimizer/tests/different-langs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
rename to collects/tests/typed-racket/optimizer/tests/different-langs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/double-float.rkt b/collects/tests/typed-racket/optimizer/tests/double-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/double-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/double-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt b/collects/tests/typed-racket/optimizer/tests/exact-inexact.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
rename to collects/tests/typed-racket/optimizer/tests/exact-inexact.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/false-huh-dead-code.rkt b/collects/tests/typed-racket/optimizer/tests/false-huh-dead-code.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/false-huh-dead-code.rkt
rename to collects/tests/typed-racket/optimizer/tests/false-huh-dead-code.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt b/collects/tests/typed-racket/optimizer/tests/fixnum-bounded-expr.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/fixnum-bounded-expr.rkt
rename to collects/tests/typed-racket/optimizer/tests/fixnum-bounded-expr.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt b/collects/tests/typed-racket/optimizer/tests/fixnum-comparison.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
rename to collects/tests/typed-racket/optimizer/tests/fixnum-comparison.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt b/collects/tests/typed-racket/optimizer/tests/float-comp.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-comp.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate-top.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-conjugate-top.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate-top.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-conjugate-top.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-conjugate.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-conjugate.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-div.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-div.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-div.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-div.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float-div.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-float-div.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-float-div.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-float-div.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float-mul.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-float-mul.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-float-mul.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-float-mul.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float-small.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-float-small.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-float-small.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-float-small.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-i.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-i.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-i.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-i.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-integer.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-integer.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-integer.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-integer.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-mult.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-mult.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-mult.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-mult.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-parts.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-parts.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-parts.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-parts.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-parts2.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-parts2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-parts2.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-parts2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-parts3.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-parts3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-parts3.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-parts3.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-sin.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex-sin.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex-sin.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex-sin.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex.rkt b/collects/tests/typed-racket/optimizer/tests/float-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-complex.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt b/collects/tests/typed-racket/optimizer/tests/float-fun.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-fun.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt b/collects/tests/typed-racket/optimizer/tests/float-promotion.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-promotion.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-real.rkt b/collects/tests/typed-racket/optimizer/tests/float-real.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/float-real.rkt
rename to collects/tests/typed-racket/optimizer/tests/float-real.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt b/collects/tests/typed-racket/optimizer/tests/flvector-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
rename to collects/tests/typed-racket/optimizer/tests/flvector-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt b/collects/tests/typed-racket/optimizer/tests/fx-fl.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
rename to collects/tests/typed-racket/optimizer/tests/fx-fl.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt b/collects/tests/typed-racket/optimizer/tests/in-bytes.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
rename to collects/tests/typed-racket/optimizer/tests/in-bytes.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt b/collects/tests/typed-racket/optimizer/tests/in-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/in-list.rkt
rename to collects/tests/typed-racket/optimizer/tests/in-list.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt b/collects/tests/typed-racket/optimizer/tests/in-string.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/in-string.rkt
rename to collects/tests/typed-racket/optimizer/tests/in-string.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt b/collects/tests/typed-racket/optimizer/tests/in-vector.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
rename to collects/tests/typed-racket/optimizer/tests/in-vector.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-derived-pair.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-derived-pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-derived-pair.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-derived-pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-exact-inexact.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-exact-inexact.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-float-comp.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-float-comp.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-float-promotion.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-float-promotion.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-inexact-complex-parts.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-inexact-complex-parts.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-log-complex.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-log-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-log-complex.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-log-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-make-flrectangular.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-make-flrectangular.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-make-polar.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-make-polar.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-mpair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-mpair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-sqrt.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-sqrt.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-unboxed-let.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-unboxed-let.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-unboxed-let2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-unboxed-let2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-vector-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-vector-ref.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt b/collects/tests/typed-racket/optimizer/tests/invalid-vector-set.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt
rename to collects/tests/typed-racket/optimizer/tests/invalid-vector-set.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/known-length-lists.rkt b/collects/tests/typed-racket/optimizer/tests/known-length-lists.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/known-length-lists.rkt
rename to collects/tests/typed-racket/optimizer/tests/known-length-lists.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt b/collects/tests/typed-racket/optimizer/tests/known-vector-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
rename to collects/tests/typed-racket/optimizer/tests/known-vector-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt b/collects/tests/typed-racket/optimizer/tests/let-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/let-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/let-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt b/collects/tests/typed-racket/optimizer/tests/let-rhs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
rename to collects/tests/typed-racket/optimizer/tests/let-rhs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt b/collects/tests/typed-racket/optimizer/tests/literal-int.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
rename to collects/tests/typed-racket/optimizer/tests/literal-int.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt b/collects/tests/typed-racket/optimizer/tests/magnitude.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
rename to collects/tests/typed-racket/optimizer/tests/magnitude.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt b/collects/tests/typed-racket/optimizer/tests/make-flrectangular.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
rename to collects/tests/typed-racket/optimizer/tests/make-flrectangular.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt b/collects/tests/typed-racket/optimizer/tests/make-polar.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
rename to collects/tests/typed-racket/optimizer/tests/make-polar.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt b/collects/tests/typed-racket/optimizer/tests/maybe-exact-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
rename to collects/tests/typed-racket/optimizer/tests/maybe-exact-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/module-path.rkt b/collects/tests/typed-racket/optimizer/tests/module-path.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/module-path.rkt
rename to collects/tests/typed-racket/optimizer/tests/module-path.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt b/collects/tests/typed-racket/optimizer/tests/mpair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/mpair.rkt
rename to collects/tests/typed-racket/optimizer/tests/mpair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/n-ary-float-complex.rkt b/collects/tests/typed-racket/optimizer/tests/n-ary-float-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/n-ary-float-complex.rkt
rename to collects/tests/typed-racket/optimizer/tests/n-ary-float-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt b/collects/tests/typed-racket/optimizer/tests/n-ary-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/n-ary-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float-complex.rkt b/collects/tests/typed-racket/optimizer/tests/nested-float-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-float-complex.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-float-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt b/collects/tests/typed-racket/optimizer/tests/nested-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt b/collects/tests/typed-racket/optimizer/tests/nested-float2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-float2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt b/collects/tests/typed-racket/optimizer/tests/nested-let-loop.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-let-loop.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt b/collects/tests/typed-racket/optimizer/tests/nested-pair1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-pair1.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt b/collects/tests/typed-racket/optimizer/tests/nested-pair2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-pair2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt b/collects/tests/typed-racket/optimizer/tests/nested-unboxed-let.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
rename to collects/tests/typed-racket/optimizer/tests/nested-unboxed-let.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt b/collects/tests/typed-racket/optimizer/tests/one-arg-arith.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
rename to collects/tests/typed-racket/optimizer/tests/one-arg-arith.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt b/collects/tests/typed-racket/optimizer/tests/pair-fun.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
rename to collects/tests/typed-racket/optimizer/tests/pair-fun.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/pair-known-length-list.rkt b/collects/tests/typed-racket/optimizer/tests/pair-known-length-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/pair-known-length-list.rkt
rename to collects/tests/typed-racket/optimizer/tests/pair-known-length-list.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/quote.rkt b/collects/tests/typed-racket/optimizer/tests/quote.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/quote.rkt
rename to collects/tests/typed-racket/optimizer/tests/quote.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/rational-literal.rkt b/collects/tests/typed-racket/optimizer/tests/rational-literal.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/rational-literal.rkt
rename to collects/tests/typed-racket/optimizer/tests/rational-literal.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt b/collects/tests/typed-racket/optimizer/tests/real-part-loop.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
rename to collects/tests/typed-racket/optimizer/tests/real-part-loop.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/silent-dead-branch.rkt b/collects/tests/typed-racket/optimizer/tests/silent-dead-branch.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/silent-dead-branch.rkt
rename to collects/tests/typed-racket/optimizer/tests/silent-dead-branch.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt b/collects/tests/typed-racket/optimizer/tests/simple-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/simple-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt b/collects/tests/typed-racket/optimizer/tests/simple-pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
rename to collects/tests/typed-racket/optimizer/tests/simple-pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt b/collects/tests/typed-racket/optimizer/tests/sqrt-segfault.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
rename to collects/tests/typed-racket/optimizer/tests/sqrt-segfault.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt b/collects/tests/typed-racket/optimizer/tests/sqrt.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
rename to collects/tests/typed-racket/optimizer/tests/sqrt.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/string-length.rkt b/collects/tests/typed-racket/optimizer/tests/string-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/string-length.rkt
rename to collects/tests/typed-racket/optimizer/tests/string-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/structs.rkt b/collects/tests/typed-racket/optimizer/tests/structs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/structs.rkt
rename to collects/tests/typed-racket/optimizer/tests/structs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt b/collects/tests/typed-racket/optimizer/tests/unary-fixnum-nested.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
rename to collects/tests/typed-racket/optimizer/tests/unary-fixnum-nested.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt b/collects/tests/typed-racket/optimizer/tests/unary-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
rename to collects/tests/typed-racket/optimizer/tests/unary-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt b/collects/tests/typed-racket/optimizer/tests/unary-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
rename to collects/tests/typed-racket/optimizer/tests/unary-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-for.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-for.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions1.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions3.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions4.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions4.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions5.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions5.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions6.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions6.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions7.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions7.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let-functions8.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let-functions8.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-let3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-let3.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-letrec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-letrec.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt b/collects/tests/typed-racket/optimizer/tests/unboxed-make-rectangular.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
rename to collects/tests/typed-racket/optimizer/tests/unboxed-make-rectangular.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt b/collects/tests/typed-racket/optimizer/tests/vector-length-nested.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-length-nested.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt b/collects/tests/typed-racket/optimizer/tests/vector-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt b/collects/tests/typed-racket/optimizer/tests/vector-ref-set-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-ref-set-ref.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt b/collects/tests/typed-racket/optimizer/tests/vector-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-ref.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt b/collects/tests/typed-racket/optimizer/tests/vector-ref2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-ref2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt b/collects/tests/typed-racket/optimizer/tests/vector-set-quote.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-set-quote.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt b/collects/tests/typed-racket/optimizer/tests/vector-set.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-set.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt b/collects/tests/typed-racket/optimizer/tests/vector-set2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-set2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-sum.rkt b/collects/tests/typed-racket/optimizer/tests/vector-sum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/vector-sum.rkt
rename to collects/tests/typed-racket/optimizer/tests/vector-sum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/with-type.rkt b/collects/tests/typed-racket/optimizer/tests/with-type.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/with-type.rkt
rename to collects/tests/typed-racket/optimizer/tests/with-type.rkt
diff --git a/collects/tests/typed-scheme/optimizer/tests/zero.rkt b/collects/tests/typed-racket/optimizer/tests/zero.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/tests/zero.rkt
rename to collects/tests/typed-racket/optimizer/tests/zero.rkt
diff --git a/collects/tests/typed-scheme/optimizer/transform.rkt b/collects/tests/typed-racket/optimizer/transform.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/transform.rkt
rename to collects/tests/typed-racket/optimizer/transform.rkt
diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-racket/run.rkt
similarity index 98%
rename from collects/tests/typed-scheme/run.rkt
rename to collects/tests/typed-racket/run.rkt
index d014a95eb6..a8a7880e23 100644
--- a/collects/tests/typed-scheme/run.rkt
+++ b/collects/tests/typed-racket/run.rkt
@@ -20,7 +20,7 @@
  ["--missed-opt" "run the missed optimization tests" (missed-opt? #t)]
  ["--benchmarks" "compile the typed benchmarks" (bench? #t)]
  ["--just" path "run only this test" (single (just-one path))]
- ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (opt? #t))]
+ ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (opt? #t) (missed-opt? #t))]
  ["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (missed-opt? #t) (bench? #t))]
  ["--gui" "run using the gui"
           (if (gui-available?)
diff --git a/collects/tests/typed-scheme/succeed/andmap.rkt b/collects/tests/typed-racket/succeed/andmap.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/andmap.rkt
rename to collects/tests/typed-racket/succeed/andmap.rkt
diff --git a/collects/tests/typed-scheme/succeed/annotation-test.rkt b/collects/tests/typed-racket/succeed/annotation-test.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/annotation-test.rkt
rename to collects/tests/typed-racket/succeed/annotation-test.rkt
diff --git a/collects/tests/typed-scheme/succeed/apply-append.rkt b/collects/tests/typed-racket/succeed/apply-append.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/apply-append.rkt
rename to collects/tests/typed-racket/succeed/apply-append.rkt
diff --git a/collects/tests/typed-scheme/succeed/apply-dots-list.rkt b/collects/tests/typed-racket/succeed/apply-dots-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/apply-dots-list.rkt
rename to collects/tests/typed-racket/succeed/apply-dots-list.rkt
diff --git a/collects/tests/typed-scheme/succeed/apply-dots.rkt b/collects/tests/typed-racket/succeed/apply-dots.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/apply-dots.rkt
rename to collects/tests/typed-racket/succeed/apply-dots.rkt
diff --git a/collects/tests/typed-scheme/succeed/area.rkt b/collects/tests/typed-racket/succeed/area.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/area.rkt
rename to collects/tests/typed-racket/succeed/area.rkt
diff --git a/collects/tests/typed-scheme/succeed/at-exp.rkt b/collects/tests/typed-racket/succeed/at-exp.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/at-exp.rkt
rename to collects/tests/typed-racket/succeed/at-exp.rkt
diff --git a/collects/tests/typed-scheme/succeed/bad-map-infer.rkt b/collects/tests/typed-racket/succeed/bad-map-infer.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/bad-map-infer.rkt
rename to collects/tests/typed-racket/succeed/bad-map-infer.rkt
diff --git a/collects/tests/typed-scheme/succeed/barland.rkt b/collects/tests/typed-racket/succeed/barland.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/barland.rkt
rename to collects/tests/typed-racket/succeed/barland.rkt
diff --git a/collects/tests/typed-scheme/succeed/basic-tests.rkt b/collects/tests/typed-racket/succeed/basic-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/basic-tests.rkt
rename to collects/tests/typed-racket/succeed/basic-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/batched-queue.scm b/collects/tests/typed-racket/succeed/batched-queue.scm
similarity index 100%
rename from collects/tests/typed-scheme/succeed/batched-queue.scm
rename to collects/tests/typed-racket/succeed/batched-queue.scm
diff --git a/collects/tests/typed-scheme/succeed/begin0-error.rkt b/collects/tests/typed-racket/succeed/begin0-error.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/begin0-error.rkt
rename to collects/tests/typed-racket/succeed/begin0-error.rkt
diff --git a/collects/tests/typed-scheme/succeed/box-num.rkt b/collects/tests/typed-racket/succeed/box-num.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/box-num.rkt
rename to collects/tests/typed-racket/succeed/box-num.rkt
diff --git a/collects/tests/typed-scheme/succeed/broken-let-syntax.rkt b/collects/tests/typed-racket/succeed/broken-let-syntax.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/broken-let-syntax.rkt
rename to collects/tests/typed-racket/succeed/broken-let-syntax.rkt
diff --git a/collects/tests/typed-scheme/succeed/check-expect.rkt b/collects/tests/typed-racket/succeed/check-expect.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/check-expect.rkt
rename to collects/tests/typed-racket/succeed/check-expect.rkt
diff --git a/collects/tests/typed-scheme/succeed/check-within.rkt b/collects/tests/typed-racket/succeed/check-within.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/check-within.rkt
rename to collects/tests/typed-racket/succeed/check-within.rkt
diff --git a/collects/tests/typed-scheme/succeed/cl-bug.rkt b/collects/tests/typed-racket/succeed/cl-bug.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/cl-bug.rkt
rename to collects/tests/typed-racket/succeed/cl-bug.rkt
diff --git a/collects/tests/typed-scheme/succeed/cl-tests.rkt b/collects/tests/typed-racket/succeed/cl-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/cl-tests.rkt
rename to collects/tests/typed-racket/succeed/cl-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/cl.rkt b/collects/tests/typed-racket/succeed/cl.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/cl.rkt
rename to collects/tests/typed-racket/succeed/cl.rkt
diff --git a/collects/tests/typed-scheme/succeed/cmdline.rkt b/collects/tests/typed-racket/succeed/cmdline.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/cmdline.rkt
rename to collects/tests/typed-racket/succeed/cmdline.rkt
diff --git a/collects/tests/typed-scheme/succeed/cps.rkt b/collects/tests/typed-racket/succeed/cps.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/cps.rkt
rename to collects/tests/typed-racket/succeed/cps.rkt
diff --git a/collects/tests/typed-scheme/succeed/datum-to-syntax.rkt b/collects/tests/typed-racket/succeed/datum-to-syntax.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/datum-to-syntax.rkt
rename to collects/tests/typed-racket/succeed/datum-to-syntax.rkt
diff --git a/collects/tests/typed-scheme/succeed/def-pred.rkt b/collects/tests/typed-racket/succeed/def-pred.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/def-pred.rkt
rename to collects/tests/typed-racket/succeed/def-pred.rkt
diff --git a/collects/tests/typed-scheme/succeed/do.rkt b/collects/tests/typed-racket/succeed/do.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/do.rkt
rename to collects/tests/typed-racket/succeed/do.rkt
diff --git a/collects/tests/typed-scheme/succeed/dot-intro.rkt b/collects/tests/typed-racket/succeed/dot-intro.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/dot-intro.rkt
rename to collects/tests/typed-racket/succeed/dot-intro.rkt
diff --git a/collects/tests/typed-scheme/succeed/dotted-identity.rkt b/collects/tests/typed-racket/succeed/dotted-identity.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/dotted-identity.rkt
rename to collects/tests/typed-racket/succeed/dotted-identity.rkt
diff --git a/collects/tests/typed-scheme/succeed/dotted-identity2.rkt b/collects/tests/typed-racket/succeed/dotted-identity2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/dotted-identity2.rkt
rename to collects/tests/typed-racket/succeed/dotted-identity2.rkt
diff --git a/collects/tests/typed-scheme/succeed/empty-or.rkt b/collects/tests/typed-racket/succeed/empty-or.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/empty-or.rkt
rename to collects/tests/typed-racket/succeed/empty-or.rkt
diff --git a/collects/tests/typed-scheme/succeed/ephemerons.rkt b/collects/tests/typed-racket/succeed/ephemerons.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/ephemerons.rkt
rename to collects/tests/typed-racket/succeed/ephemerons.rkt
diff --git a/collects/tests/typed-scheme/succeed/even-odd.rkt b/collects/tests/typed-racket/succeed/even-odd.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/even-odd.rkt
rename to collects/tests/typed-racket/succeed/even-odd.rkt
diff --git a/collects/tests/typed-scheme/succeed/exceptions.rkt b/collects/tests/typed-racket/succeed/exceptions.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/exceptions.rkt
rename to collects/tests/typed-racket/succeed/exceptions.rkt
diff --git a/collects/tests/typed-scheme/succeed/fix.rkt b/collects/tests/typed-racket/succeed/fix.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/fix.rkt
rename to collects/tests/typed-racket/succeed/fix.rkt
diff --git a/collects/tests/typed-scheme/succeed/fixnum.rkt b/collects/tests/typed-racket/succeed/fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/fixnum.rkt
rename to collects/tests/typed-racket/succeed/fixnum.rkt
diff --git a/collects/tests/typed-scheme/succeed/float-internal-err.rkt b/collects/tests/typed-racket/succeed/float-internal-err.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/float-internal-err.rkt
rename to collects/tests/typed-racket/succeed/float-internal-err.rkt
diff --git a/collects/tests/typed-scheme/succeed/flonum.rkt b/collects/tests/typed-racket/succeed/flonum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/flonum.rkt
rename to collects/tests/typed-racket/succeed/flonum.rkt
diff --git a/collects/tests/typed-scheme/succeed/flvector.rkt b/collects/tests/typed-racket/succeed/flvector.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/flvector.rkt
rename to collects/tests/typed-racket/succeed/flvector.rkt
diff --git a/collects/tests/typed-scheme/succeed/fold-left-inst.rkt b/collects/tests/typed-racket/succeed/fold-left-inst.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/fold-left-inst.rkt
rename to collects/tests/typed-racket/succeed/fold-left-inst.rkt
diff --git a/collects/tests/typed-scheme/succeed/fold-left.rkt b/collects/tests/typed-racket/succeed/fold-left.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/fold-left.rkt
rename to collects/tests/typed-racket/succeed/fold-left.rkt
diff --git a/collects/tests/typed-scheme/succeed/foldo.rkt b/collects/tests/typed-racket/succeed/foldo.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/foldo.rkt
rename to collects/tests/typed-racket/succeed/foldo.rkt
diff --git a/collects/tests/typed-scheme/succeed/foo.scm b/collects/tests/typed-racket/succeed/foo.scm
similarity index 100%
rename from collects/tests/typed-scheme/succeed/foo.scm
rename to collects/tests/typed-racket/succeed/foo.scm
diff --git a/collects/tests/typed-scheme/succeed/for-ann.rkt b/collects/tests/typed-racket/succeed/for-ann.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-ann.rkt
rename to collects/tests/typed-racket/succeed/for-ann.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-in-range.rkt b/collects/tests/typed-racket/succeed/for-in-range.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-in-range.rkt
rename to collects/tests/typed-racket/succeed/for-in-range.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-list.rkt b/collects/tests/typed-racket/succeed/for-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-list.rkt
rename to collects/tests/typed-racket/succeed/for-list.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-lists.rkt b/collects/tests/typed-racket/succeed/for-lists.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-lists.rkt
rename to collects/tests/typed-racket/succeed/for-lists.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-no-anns.rkt b/collects/tests/typed-racket/succeed/for-no-anns.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-no-anns.rkt
rename to collects/tests/typed-racket/succeed/for-no-anns.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-no-body-anns.rkt b/collects/tests/typed-racket/succeed/for-no-body-anns.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-no-body-anns.rkt
rename to collects/tests/typed-racket/succeed/for-no-body-anns.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-over-hash.rkt b/collects/tests/typed-racket/succeed/for-over-hash.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-over-hash.rkt
rename to collects/tests/typed-racket/succeed/for-over-hash.rkt
diff --git a/collects/tests/typed-scheme/succeed/for-seq.rkt b/collects/tests/typed-racket/succeed/for-seq.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for-seq.rkt
rename to collects/tests/typed-racket/succeed/for-seq.rkt
diff --git a/collects/tests/typed-scheme/succeed/for.rkt b/collects/tests/typed-racket/succeed/for.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/for.rkt
rename to collects/tests/typed-racket/succeed/for.rkt
diff --git a/collects/tests/typed-scheme/succeed/force-delay.rkt b/collects/tests/typed-racket/succeed/force-delay.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/force-delay.rkt
rename to collects/tests/typed-racket/succeed/force-delay.rkt
diff --git a/collects/tests/typed-scheme/succeed/function.rkt b/collects/tests/typed-racket/succeed/function.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/function.rkt
rename to collects/tests/typed-racket/succeed/function.rkt
diff --git a/collects/tests/typed-scheme/succeed/fx-filter.rkt b/collects/tests/typed-racket/succeed/fx-filter.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/fx-filter.rkt
rename to collects/tests/typed-racket/succeed/fx-filter.rkt
diff --git a/collects/tests/typed-scheme/succeed/generalize-vectors.rkt b/collects/tests/typed-racket/succeed/generalize-vectors.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/generalize-vectors.rkt
rename to collects/tests/typed-racket/succeed/generalize-vectors.rkt
diff --git a/collects/tests/typed-scheme/succeed/hari-vector-bug.rkt b/collects/tests/typed-racket/succeed/hari-vector-bug.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/hari-vector-bug.rkt
rename to collects/tests/typed-racket/succeed/hari-vector-bug.rkt
diff --git a/collects/tests/typed-scheme/succeed/hash-ref.rkt b/collects/tests/typed-racket/succeed/hash-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/hash-ref.rkt
rename to collects/tests/typed-racket/succeed/hash-ref.rkt
diff --git a/collects/tests/typed-scheme/succeed/het-vec.rkt b/collects/tests/typed-racket/succeed/het-vec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/het-vec.rkt
rename to collects/tests/typed-racket/succeed/het-vec.rkt
diff --git a/collects/tests/typed-scheme/succeed/het-vec2.rkt b/collects/tests/typed-racket/succeed/het-vec2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/het-vec2.rkt
rename to collects/tests/typed-racket/succeed/het-vec2.rkt
diff --git a/collects/tests/typed-scheme/succeed/ho-box.rkt b/collects/tests/typed-racket/succeed/ho-box.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/ho-box.rkt
rename to collects/tests/typed-racket/succeed/ho-box.rkt
diff --git a/collects/tests/typed-scheme/succeed/hw01.scm b/collects/tests/typed-racket/succeed/hw01.scm
similarity index 100%
rename from collects/tests/typed-scheme/succeed/hw01.scm
rename to collects/tests/typed-racket/succeed/hw01.scm
diff --git a/collects/tests/typed-scheme/succeed/icfp-examples.rkt b/collects/tests/typed-racket/succeed/icfp-examples.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/icfp-examples.rkt
rename to collects/tests/typed-racket/succeed/icfp-examples.rkt
diff --git a/collects/tests/typed-scheme/succeed/if-splitting-test.rkt b/collects/tests/typed-racket/succeed/if-splitting-test.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/if-splitting-test.rkt
rename to collects/tests/typed-racket/succeed/if-splitting-test.rkt
diff --git a/collects/tests/typed-scheme/succeed/inexact-complex.rkt b/collects/tests/typed-racket/succeed/inexact-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/inexact-complex.rkt
rename to collects/tests/typed-racket/succeed/inexact-complex.rkt
diff --git a/collects/tests/typed-scheme/succeed/infer-dots.rkt b/collects/tests/typed-racket/succeed/infer-dots.rkt
similarity index 93%
rename from collects/tests/typed-scheme/succeed/infer-dots.rkt
rename to collects/tests/typed-racket/succeed/infer-dots.rkt
index 69f766e5e3..d5a43c14e4 100644
--- a/collects/tests/typed-scheme/succeed/infer-dots.rkt
+++ b/collects/tests/typed-racket/succeed/infer-dots.rkt
@@ -1,6 +1,6 @@
 #lang typed-scheme
 
-(require typed-scheme/base-env/extra-procs)
+(require typed-racket/base-env/extra-procs)
 
 (: f (Integer Integer -> Integer))
 (define (f x y) (+ x y))
diff --git a/collects/tests/typed-scheme/succeed/infer-funargs.rkt b/collects/tests/typed-racket/succeed/infer-funargs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/infer-funargs.rkt
rename to collects/tests/typed-racket/succeed/infer-funargs.rkt
diff --git a/collects/tests/typed-scheme/succeed/inst-dots.rkt b/collects/tests/typed-racket/succeed/inst-dots.rkt
similarity index 69%
rename from collects/tests/typed-scheme/succeed/inst-dots.rkt
rename to collects/tests/typed-racket/succeed/inst-dots.rkt
index 571c51f261..05d56c278e 100644
--- a/collects/tests/typed-scheme/succeed/inst-dots.rkt
+++ b/collects/tests/typed-racket/succeed/inst-dots.rkt
@@ -1,6 +1,6 @@
-#lang typed-scheme
+#lang typed/racket
 
-(require typed-scheme/base-env/extra-procs)
+(require typed-racket/base-env/extra-procs)
 
 ((inst map Number Number Number Number Number Number Number)
  +
diff --git a/collects/tests/typed-scheme/succeed/inst-expected.rkt b/collects/tests/typed-racket/succeed/inst-expected.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/inst-expected.rkt
rename to collects/tests/typed-racket/succeed/inst-expected.rkt
diff --git a/collects/tests/typed-scheme/succeed/int-def-colon.rkt b/collects/tests/typed-racket/succeed/int-def-colon.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/int-def-colon.rkt
rename to collects/tests/typed-racket/succeed/int-def-colon.rkt
diff --git a/collects/tests/typed-scheme/succeed/kw.rkt b/collects/tests/typed-racket/succeed/kw.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/kw.rkt
rename to collects/tests/typed-racket/succeed/kw.rkt
diff --git a/collects/tests/typed-scheme/succeed/leftist-heap.rkt b/collects/tests/typed-racket/succeed/leftist-heap.rkt
similarity index 98%
rename from collects/tests/typed-scheme/succeed/leftist-heap.rkt
rename to collects/tests/typed-racket/succeed/leftist-heap.rkt
index 4d87e6c386..3dd6f1aaf9 100644
--- a/collects/tests/typed-scheme/succeed/leftist-heap.rkt
+++ b/collects/tests/typed-racket/succeed/leftist-heap.rkt
@@ -23,10 +23,6 @@
 ;; need rest args
 ;; didn't attempt generators
 
-;#reader (planet "typed-reader.rkt" ("plt" "typed-scheme.plt"))
-;(module leftist-heap (planet "typed-scheme.rkt" ("plt" "typed-scheme.plt" 3 0))
-;(module leftist-heap mzscheme
-
 #lang typed-scheme
 (define-type-alias number Number)
 (define-type-alias boolean Boolean)
diff --git a/collects/tests/typed-scheme/succeed/let-no-anns.rkt b/collects/tests/typed-racket/succeed/let-no-anns.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/let-no-anns.rkt
rename to collects/tests/typed-racket/succeed/let-no-anns.rkt
diff --git a/collects/tests/typed-scheme/succeed/let-values-tests.rkt b/collects/tests/typed-racket/succeed/let-values-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/let-values-tests.rkt
rename to collects/tests/typed-racket/succeed/let-values-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/list-dots.rkt b/collects/tests/typed-racket/succeed/list-dots.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/list-dots.rkt
rename to collects/tests/typed-racket/succeed/list-dots.rkt
diff --git a/collects/tests/typed-scheme/succeed/list-ref-vec.rkt b/collects/tests/typed-racket/succeed/list-ref-vec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/list-ref-vec.rkt
rename to collects/tests/typed-racket/succeed/list-ref-vec.rkt
diff --git a/collects/tests/typed-scheme/succeed/list-struct-sum.rkt b/collects/tests/typed-racket/succeed/list-struct-sum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/list-struct-sum.rkt
rename to collects/tests/typed-racket/succeed/list-struct-sum.rkt
diff --git a/collects/tests/typed-scheme/succeed/little-schemer.rkt b/collects/tests/typed-racket/succeed/little-schemer.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/little-schemer.rkt
rename to collects/tests/typed-racket/succeed/little-schemer.rkt
diff --git a/collects/tests/typed-scheme/succeed/logic.rkt b/collects/tests/typed-racket/succeed/logic.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/logic.rkt
rename to collects/tests/typed-racket/succeed/logic.rkt
diff --git a/collects/tests/typed-scheme/succeed/lots-o-bugs.rkt b/collects/tests/typed-racket/succeed/lots-o-bugs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/lots-o-bugs.rkt
rename to collects/tests/typed-racket/succeed/lots-o-bugs.rkt
diff --git a/collects/tests/typed-scheme/succeed/mandelbrot.rkt b/collects/tests/typed-racket/succeed/mandelbrot.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/mandelbrot.rkt
rename to collects/tests/typed-racket/succeed/mandelbrot.rkt
diff --git a/collects/tests/typed-scheme/succeed/manual-examples.rkt b/collects/tests/typed-racket/succeed/manual-examples.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/manual-examples.rkt
rename to collects/tests/typed-racket/succeed/manual-examples.rkt
diff --git a/collects/tests/typed-scheme/succeed/map-nonempty.rkt b/collects/tests/typed-racket/succeed/map-nonempty.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/map-nonempty.rkt
rename to collects/tests/typed-racket/succeed/map-nonempty.rkt
diff --git a/collects/tests/typed-scheme/succeed/map1.rkt b/collects/tests/typed-racket/succeed/map1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/map1.rkt
rename to collects/tests/typed-racket/succeed/map1.rkt
diff --git a/collects/tests/typed-scheme/succeed/map2.rkt b/collects/tests/typed-racket/succeed/map2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/map2.rkt
rename to collects/tests/typed-racket/succeed/map2.rkt
diff --git a/collects/tests/typed-scheme/succeed/match-dots.rkt b/collects/tests/typed-racket/succeed/match-dots.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/match-dots.rkt
rename to collects/tests/typed-racket/succeed/match-dots.rkt
diff --git a/collects/tests/typed-scheme/succeed/match-dots2.rkt b/collects/tests/typed-racket/succeed/match-dots2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/match-dots2.rkt
rename to collects/tests/typed-racket/succeed/match-dots2.rkt
diff --git a/collects/tests/typed-scheme/succeed/match-expander-problem.rkt b/collects/tests/typed-racket/succeed/match-expander-problem.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/match-expander-problem.rkt
rename to collects/tests/typed-racket/succeed/match-expander-problem.rkt
diff --git a/collects/tests/typed-scheme/succeed/match-tests.rkt b/collects/tests/typed-racket/succeed/match-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/match-tests.rkt
rename to collects/tests/typed-racket/succeed/match-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/match.rkt b/collects/tests/typed-racket/succeed/match.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/match.rkt
rename to collects/tests/typed-racket/succeed/match.rkt
diff --git a/collects/tests/typed-scheme/succeed/member-pred.rkt b/collects/tests/typed-racket/succeed/member-pred.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/member-pred.rkt
rename to collects/tests/typed-racket/succeed/member-pred.rkt
diff --git a/collects/tests/typed-scheme/succeed/metrics.rkt b/collects/tests/typed-racket/succeed/metrics.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/metrics.rkt
rename to collects/tests/typed-racket/succeed/metrics.rkt
diff --git a/collects/tests/typed-scheme/succeed/module-lang.rkt b/collects/tests/typed-racket/succeed/module-lang.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/module-lang.rkt
rename to collects/tests/typed-racket/succeed/module-lang.rkt
diff --git a/collects/tests/typed-scheme/succeed/mpair.rkt b/collects/tests/typed-racket/succeed/mpair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/mpair.rkt
rename to collects/tests/typed-racket/succeed/mpair.rkt
diff --git a/collects/tests/typed-scheme/succeed/mu-rec.rkt b/collects/tests/typed-racket/succeed/mu-rec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/mu-rec.rkt
rename to collects/tests/typed-racket/succeed/mu-rec.rkt
diff --git a/collects/tests/typed-scheme/succeed/multi-arr-parse.rkt b/collects/tests/typed-racket/succeed/multi-arr-parse.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/multi-arr-parse.rkt
rename to collects/tests/typed-racket/succeed/multi-arr-parse.rkt
diff --git a/collects/tests/typed-scheme/succeed/mutable-poly-struct.rkt b/collects/tests/typed-racket/succeed/mutable-poly-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/mutable-poly-struct.rkt
rename to collects/tests/typed-racket/succeed/mutable-poly-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/mutable-struct-pred.rkt b/collects/tests/typed-racket/succeed/mutable-struct-pred.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/mutable-struct-pred.rkt
rename to collects/tests/typed-racket/succeed/mutable-struct-pred.rkt
diff --git a/collects/tests/typed-scheme/succeed/nested-poly.rkt b/collects/tests/typed-racket/succeed/nested-poly.rkt
similarity index 91%
rename from collects/tests/typed-scheme/succeed/nested-poly.rkt
rename to collects/tests/typed-racket/succeed/nested-poly.rkt
index 18d3e48a29..27620d07c8 100644
--- a/collects/tests/typed-scheme/succeed/nested-poly.rkt
+++ b/collects/tests/typed-racket/succeed/nested-poly.rkt
@@ -1,6 +1,6 @@
 #lang typed-scheme
 
-(require typed-scheme/base-env/extra-procs)
+(require typed-racket/base-env/extra-procs)
 
 (: f (All (A ...) (All (B ...) (A ... A -> Integer))))
 
diff --git a/collects/tests/typed-scheme/succeed/new-metrics.rkt b/collects/tests/typed-racket/succeed/new-metrics.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/new-metrics.rkt
rename to collects/tests/typed-racket/succeed/new-metrics.rkt
diff --git a/collects/tests/typed-scheme/succeed/no-bound-fl.rkt b/collects/tests/typed-racket/succeed/no-bound-fl.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/no-bound-fl.rkt
rename to collects/tests/typed-racket/succeed/no-bound-fl.rkt
diff --git a/collects/tests/typed-scheme/succeed/nonnegative-float.rkt b/collects/tests/typed-racket/succeed/nonnegative-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/nonnegative-float.rkt
rename to collects/tests/typed-racket/succeed/nonnegative-float.rkt
diff --git a/collects/tests/typed-scheme/succeed/null-program.rkt b/collects/tests/typed-racket/succeed/null-program.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/null-program.rkt
rename to collects/tests/typed-racket/succeed/null-program.rkt
diff --git a/collects/tests/typed-scheme/succeed/opt-arg-test.rkt b/collects/tests/typed-racket/succeed/opt-arg-test.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/opt-arg-test.rkt
rename to collects/tests/typed-racket/succeed/opt-arg-test.rkt
diff --git a/collects/tests/typed-scheme/succeed/opt-lambda.rkt b/collects/tests/typed-racket/succeed/opt-lambda.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/opt-lambda.rkt
rename to collects/tests/typed-racket/succeed/opt-lambda.rkt
diff --git a/collects/tests/typed-scheme/succeed/optimize-simple.rkt b/collects/tests/typed-racket/succeed/optimize-simple.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/optimize-simple.rkt
rename to collects/tests/typed-racket/succeed/optimize-simple.rkt
diff --git a/collects/tests/typed-scheme/succeed/or-sym.rkt b/collects/tests/typed-racket/succeed/or-sym.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/or-sym.rkt
rename to collects/tests/typed-racket/succeed/or-sym.rkt
diff --git a/collects/tests/typed-scheme/succeed/overloading.rkt b/collects/tests/typed-racket/succeed/overloading.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/overloading.rkt
rename to collects/tests/typed-racket/succeed/overloading.rkt
diff --git a/collects/tests/typed-scheme/succeed/pair-test.rkt b/collects/tests/typed-racket/succeed/pair-test.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pair-test.rkt
rename to collects/tests/typed-racket/succeed/pair-test.rkt
diff --git a/collects/tests/typed-scheme/succeed/pair-test2.rkt b/collects/tests/typed-racket/succeed/pair-test2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pair-test2.rkt
rename to collects/tests/typed-racket/succeed/pair-test2.rkt
diff --git a/collects/tests/typed-scheme/succeed/pair-test3.rkt b/collects/tests/typed-racket/succeed/pair-test3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pair-test3.rkt
rename to collects/tests/typed-racket/succeed/pair-test3.rkt
diff --git a/collects/tests/typed-scheme/succeed/param.rkt b/collects/tests/typed-racket/succeed/param.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/param.rkt
rename to collects/tests/typed-racket/succeed/param.rkt
diff --git a/collects/tests/typed-scheme/succeed/parse-path.rkt b/collects/tests/typed-racket/succeed/parse-path.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/parse-path.rkt
rename to collects/tests/typed-racket/succeed/parse-path.rkt
diff --git a/collects/tests/typed-scheme/succeed/patch.rkt b/collects/tests/typed-racket/succeed/patch.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/patch.rkt
rename to collects/tests/typed-racket/succeed/patch.rkt
diff --git a/collects/tests/typed-scheme/succeed/paths.rkt b/collects/tests/typed-racket/succeed/paths.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/paths.rkt
rename to collects/tests/typed-racket/succeed/paths.rkt
diff --git a/collects/tests/typed-scheme/succeed/pathstrings.rkt b/collects/tests/typed-racket/succeed/pathstrings.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pathstrings.rkt
rename to collects/tests/typed-racket/succeed/pathstrings.rkt
diff --git a/collects/tests/typed-scheme/succeed/places-helper.rkt b/collects/tests/typed-racket/succeed/places-helper.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/places-helper.rkt
rename to collects/tests/typed-racket/succeed/places-helper.rkt
diff --git a/collects/tests/typed-scheme/succeed/places.rkt b/collects/tests/typed-racket/succeed/places.rkt
similarity index 58%
rename from collects/tests/typed-scheme/succeed/places.rkt
rename to collects/tests/typed-racket/succeed/places.rkt
index 9b0cdd98fd..11bd1d68f1 100644
--- a/collects/tests/typed-scheme/succeed/places.rkt
+++ b/collects/tests/typed-racket/succeed/places.rkt
@@ -4,16 +4,16 @@
 (: p2 Place)
 (: p3 Place)
 
-(define p (dynamic-place 'tests/typed-scheme/succeed/places-helper 'double-place))
+(define p (dynamic-place 'tests/typed-racket/succeed/places-helper 'double-place))
 (place-channel-put/get p 10)
 (place-wait p)
 
 
-(define p2 (dynamic-place 'tests/typed-scheme/succeed/places-helper 'double-place))
+(define p2 (dynamic-place 'tests/typed-racket/succeed/places-helper 'double-place))
 (place-channel-put/get p2 -2+4i)
 (place-wait p2)
 
 
-(define p3 (dynamic-place 'tests/typed-scheme/succeed/places-helper 'echo-place))
+(define p3 (dynamic-place 'tests/typed-racket/succeed/places-helper 'echo-place))
 (place-channel-put/get p3 'echo-this)
 (place-wait p3)
diff --git a/collects/tests/typed-scheme/succeed/poly-ret-ann.rkt b/collects/tests/typed-racket/succeed/poly-ret-ann.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/poly-ret-ann.rkt
rename to collects/tests/typed-racket/succeed/poly-ret-ann.rkt
diff --git a/collects/tests/typed-scheme/succeed/poly-struct-union.rkt b/collects/tests/typed-racket/succeed/poly-struct-union.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/poly-struct-union.rkt
rename to collects/tests/typed-racket/succeed/poly-struct-union.rkt
diff --git a/collects/tests/typed-scheme/succeed/poly-struct.rkt b/collects/tests/typed-racket/succeed/poly-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/poly-struct.rkt
rename to collects/tests/typed-racket/succeed/poly-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/poly-subtype.rkt b/collects/tests/typed-racket/succeed/poly-subtype.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/poly-subtype.rkt
rename to collects/tests/typed-racket/succeed/poly-subtype.rkt
diff --git a/collects/tests/typed-scheme/succeed/poly-tests.rkt b/collects/tests/typed-racket/succeed/poly-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/poly-tests.rkt
rename to collects/tests/typed-racket/succeed/poly-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/ports.rkt b/collects/tests/typed-racket/succeed/ports.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/ports.rkt
rename to collects/tests/typed-racket/succeed/ports.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10057.rkt b/collects/tests/typed-racket/succeed/pr10057.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10057.rkt
rename to collects/tests/typed-racket/succeed/pr10057.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10318.rkt b/collects/tests/typed-racket/succeed/pr10318.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10318.rkt
rename to collects/tests/typed-racket/succeed/pr10318.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10319.rkt b/collects/tests/typed-racket/succeed/pr10319.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10319.rkt
rename to collects/tests/typed-racket/succeed/pr10319.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10342.rkt b/collects/tests/typed-racket/succeed/pr10342.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10342.rkt
rename to collects/tests/typed-racket/succeed/pr10342.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10470.rkt b/collects/tests/typed-racket/succeed/pr10470.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10470.rkt
rename to collects/tests/typed-racket/succeed/pr10470.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10552.rkt b/collects/tests/typed-racket/succeed/pr10552.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10552.rkt
rename to collects/tests/typed-racket/succeed/pr10552.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10562.rkt b/collects/tests/typed-racket/succeed/pr10562.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10562.rkt
rename to collects/tests/typed-racket/succeed/pr10562.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10718+10755.rkt b/collects/tests/typed-racket/succeed/pr10718+10755.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10718+10755.rkt
rename to collects/tests/typed-racket/succeed/pr10718+10755.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10729.rkt b/collects/tests/typed-racket/succeed/pr10729.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10729.rkt
rename to collects/tests/typed-racket/succeed/pr10729.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10937.rkt b/collects/tests/typed-racket/succeed/pr10937.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10937.rkt
rename to collects/tests/typed-racket/succeed/pr10937.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr10939.rkt b/collects/tests/typed-racket/succeed/pr10939.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr10939.rkt
rename to collects/tests/typed-racket/succeed/pr10939.rkt
diff --git a/collects/tests/typed-racket/succeed/pr11099.rkt b/collects/tests/typed-racket/succeed/pr11099.rkt
new file mode 100644
index 0000000000..3f172bbc40
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/pr11099.rkt
@@ -0,0 +1,11 @@
+#lang typed/racket
+
+(struct: (X) b ([bar : (Vectorof X)]))
+
+(define: b-val : (b Integer)
+  (b (ann (vector 1) (Vectorof Integer))))
+
+
+(if (b? b-val)
+    (b-bar b-val) 
+    #f)
diff --git a/collects/tests/typed-scheme/succeed/pr11171.rkt b/collects/tests/typed-racket/succeed/pr11171.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11171.rkt
rename to collects/tests/typed-racket/succeed/pr11171.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11193.rkt b/collects/tests/typed-racket/succeed/pr11193.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11193.rkt
rename to collects/tests/typed-racket/succeed/pr11193.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11194.rkt b/collects/tests/typed-racket/succeed/pr11194.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11194.rkt
rename to collects/tests/typed-racket/succeed/pr11194.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11314.rkt b/collects/tests/typed-racket/succeed/pr11314.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11314.rkt
rename to collects/tests/typed-racket/succeed/pr11314.rkt
diff --git a/collects/tests/typed-racket/succeed/pr11390.rkt b/collects/tests/typed-racket/succeed/pr11390.rkt
new file mode 100644
index 0000000000..20397bf6bf
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/pr11390.rkt
@@ -0,0 +1,22 @@
+#lang typed/racket
+
+;Doesn't TypeCheck
+(struct: foo ())
+(struct: foo-num foo ((v : Number)))
+(struct: foo-str foo ((v : String)))
+
+#|
+;TypeChecks
+(struct: foo-num ((v : Number)))
+(struct: foo-str ((v : String)))
+|#
+
+
+(: extract-foo (case-lambda
+                 (foo-num -> Number)
+                 (foo-str -> String)))
+
+(define (extract-foo foo)
+  (cond
+    ((foo-num? foo) (foo-num-v foo))
+    ((foo-str? foo) (foo-str-v foo))))
diff --git a/collects/tests/typed-racket/succeed/pr11392.rkt b/collects/tests/typed-racket/succeed/pr11392.rkt
new file mode 100644
index 0000000000..78a832abe8
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/pr11392.rkt
@@ -0,0 +1,12 @@
+#lang typed/racket
+(struct: foo ((n : Number)))
+(struct: bar ((n : Number)))
+
+
+(define-type foobar (U foo bar))
+(define-predicate foobar? foobar)
+
+(: baz ((List) -> "two"))
+
+(define (baz x)
+  (if (foobar? x) 2 "two"))
diff --git a/collects/tests/typed-scheme/succeed/pr11425.rkt b/collects/tests/typed-racket/succeed/pr11425.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11425.rkt
rename to collects/tests/typed-racket/succeed/pr11425.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11504.rkt b/collects/tests/typed-racket/succeed/pr11504.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11504.rkt
rename to collects/tests/typed-racket/succeed/pr11504.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11509.rkt b/collects/tests/typed-racket/succeed/pr11509.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11509.rkt
rename to collects/tests/typed-racket/succeed/pr11509.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11532.rkt b/collects/tests/typed-racket/succeed/pr11532.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11532.rkt
rename to collects/tests/typed-racket/succeed/pr11532.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11545+11776.rkt b/collects/tests/typed-racket/succeed/pr11545+11776.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11545+11776.rkt
rename to collects/tests/typed-racket/succeed/pr11545+11776.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11560.rkt b/collects/tests/typed-racket/succeed/pr11560.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11560.rkt
rename to collects/tests/typed-racket/succeed/pr11560.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11578.rkt b/collects/tests/typed-racket/succeed/pr11578.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11578.rkt
rename to collects/tests/typed-racket/succeed/pr11578.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11617.rkt b/collects/tests/typed-racket/succeed/pr11617.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11617.rkt
rename to collects/tests/typed-racket/succeed/pr11617.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11686.rkt b/collects/tests/typed-racket/succeed/pr11686.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11686.rkt
rename to collects/tests/typed-racket/succeed/pr11686.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11709.rkt b/collects/tests/typed-racket/succeed/pr11709.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11709.rkt
rename to collects/tests/typed-racket/succeed/pr11709.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11728.rkt b/collects/tests/typed-racket/succeed/pr11728.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11728.rkt
rename to collects/tests/typed-racket/succeed/pr11728.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11756.rkt b/collects/tests/typed-racket/succeed/pr11756.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11756.rkt
rename to collects/tests/typed-racket/succeed/pr11756.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11859.rkt b/collects/tests/typed-racket/succeed/pr11859.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11859.rkt
rename to collects/tests/typed-racket/succeed/pr11859.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11866.rkt b/collects/tests/typed-racket/succeed/pr11866.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11866.rkt
rename to collects/tests/typed-racket/succeed/pr11866.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11887.rkt b/collects/tests/typed-racket/succeed/pr11887.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11887.rkt
rename to collects/tests/typed-racket/succeed/pr11887.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11897.rkt b/collects/tests/typed-racket/succeed/pr11897.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11897.rkt
rename to collects/tests/typed-racket/succeed/pr11897.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr11912.rkt b/collects/tests/typed-racket/succeed/pr11912.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr11912.rkt
rename to collects/tests/typed-racket/succeed/pr11912.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr9043.rkt b/collects/tests/typed-racket/succeed/pr9043.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr9043.rkt
rename to collects/tests/typed-racket/succeed/pr9043.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr9046.rkt b/collects/tests/typed-racket/succeed/pr9046.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr9046.rkt
rename to collects/tests/typed-racket/succeed/pr9046.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr9048.rkt b/collects/tests/typed-racket/succeed/pr9048.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr9048.rkt
rename to collects/tests/typed-racket/succeed/pr9048.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr9053-2.rkt b/collects/tests/typed-racket/succeed/pr9053-2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr9053-2.rkt
rename to collects/tests/typed-racket/succeed/pr9053-2.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr9053.rkt b/collects/tests/typed-racket/succeed/pr9053.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr9053.rkt
rename to collects/tests/typed-racket/succeed/pr9053.rkt
diff --git a/collects/tests/typed-scheme/succeed/pr9054.rkt b/collects/tests/typed-racket/succeed/pr9054.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/pr9054.rkt
rename to collects/tests/typed-racket/succeed/pr9054.rkt
diff --git a/collects/tests/typed-scheme/succeed/priority-queue.scm b/collects/tests/typed-racket/succeed/priority-queue.scm
similarity index 100%
rename from collects/tests/typed-scheme/succeed/priority-queue.scm
rename to collects/tests/typed-racket/succeed/priority-queue.scm
diff --git a/collects/tests/typed-scheme/succeed/provide-case-rest.rkt b/collects/tests/typed-racket/succeed/provide-case-rest.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/provide-case-rest.rkt
rename to collects/tests/typed-racket/succeed/provide-case-rest.rkt
diff --git a/collects/tests/typed-scheme/succeed/provide-poly-struct.rkt b/collects/tests/typed-racket/succeed/provide-poly-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/provide-poly-struct.rkt
rename to collects/tests/typed-racket/succeed/provide-poly-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/provide-sexp.rkt b/collects/tests/typed-racket/succeed/provide-sexp.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/provide-sexp.rkt
rename to collects/tests/typed-racket/succeed/provide-sexp.rkt
diff --git a/collects/tests/typed-scheme/succeed/provide-struct-untyped.rkt b/collects/tests/typed-racket/succeed/provide-struct-untyped.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/provide-struct-untyped.rkt
rename to collects/tests/typed-racket/succeed/provide-struct-untyped.rkt
diff --git a/collects/tests/typed-scheme/succeed/provide-struct.rkt b/collects/tests/typed-racket/succeed/provide-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/provide-struct.rkt
rename to collects/tests/typed-racket/succeed/provide-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/provide-syntax.rkt b/collects/tests/typed-racket/succeed/provide-syntax.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/provide-syntax.rkt
rename to collects/tests/typed-racket/succeed/provide-syntax.rkt
diff --git a/collects/tests/typed-scheme/succeed/racket-struct.rkt b/collects/tests/typed-racket/succeed/racket-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/racket-struct.rkt
rename to collects/tests/typed-racket/succeed/racket-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/rackunit.rkt b/collects/tests/typed-racket/succeed/rackunit.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/rackunit.rkt
rename to collects/tests/typed-racket/succeed/rackunit.rkt
diff --git a/collects/tests/typed-scheme/succeed/random-bits.rkt b/collects/tests/typed-racket/succeed/random-bits.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/random-bits.rkt
rename to collects/tests/typed-racket/succeed/random-bits.rkt
diff --git a/collects/tests/typed-scheme/succeed/rec-het-vec-infer.rkt b/collects/tests/typed-racket/succeed/rec-het-vec-infer.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/rec-het-vec-infer.rkt
rename to collects/tests/typed-racket/succeed/rec-het-vec-infer.rkt
diff --git a/collects/tests/typed-scheme/succeed/rec-types.rkt b/collects/tests/typed-racket/succeed/rec-types.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/rec-types.rkt
rename to collects/tests/typed-racket/succeed/rec-types.rkt
diff --git a/collects/tests/typed-scheme/succeed/refinement-even.rkt b/collects/tests/typed-racket/succeed/refinement-even.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/refinement-even.rkt
rename to collects/tests/typed-racket/succeed/refinement-even.rkt
diff --git a/collects/tests/typed-scheme/succeed/require-poly.rkt b/collects/tests/typed-racket/succeed/require-poly.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/require-poly.rkt
rename to collects/tests/typed-racket/succeed/require-poly.rkt
diff --git a/collects/tests/typed-scheme/succeed/require-procedure.rkt b/collects/tests/typed-racket/succeed/require-procedure.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/require-procedure.rkt
rename to collects/tests/typed-racket/succeed/require-procedure.rkt
diff --git a/collects/tests/typed-scheme/succeed/require-struct.rkt b/collects/tests/typed-racket/succeed/require-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/require-struct.rkt
rename to collects/tests/typed-racket/succeed/require-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/require-substruct.rkt b/collects/tests/typed-racket/succeed/require-substruct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/require-substruct.rkt
rename to collects/tests/typed-racket/succeed/require-substruct.rkt
diff --git a/collects/tests/typed-scheme/succeed/require-tests.rkt b/collects/tests/typed-racket/succeed/require-tests.rkt
similarity index 84%
rename from collects/tests/typed-scheme/succeed/require-tests.rkt
rename to collects/tests/typed-racket/succeed/require-tests.rkt
index 692278f503..1fa0bf15fe 100644
--- a/collects/tests/typed-scheme/succeed/require-tests.rkt
+++ b/collects/tests/typed-racket/succeed/require-tests.rkt
@@ -1,5 +1,5 @@
 #lang scheme/load
-#reader typed-scheme/typed-reader
+#reader typed-racket/typed-reader
 (module bang-tests typed-scheme
   (define #{x : Number} 1)
   (provide x)
diff --git a/collects/tests/typed-scheme/succeed/require-typed-parse.rkt b/collects/tests/typed-racket/succeed/require-typed-parse.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/require-typed-parse.rkt
rename to collects/tests/typed-racket/succeed/require-typed-parse.rkt
diff --git a/collects/tests/typed-scheme/succeed/require-typed-rename.rkt b/collects/tests/typed-racket/succeed/require-typed-rename.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/require-typed-rename.rkt
rename to collects/tests/typed-racket/succeed/require-typed-rename.rkt
diff --git a/collects/tests/typed-scheme/succeed/richard-bugs.rkt b/collects/tests/typed-racket/succeed/richard-bugs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/richard-bugs.rkt
rename to collects/tests/typed-racket/succeed/richard-bugs.rkt
diff --git a/collects/tests/typed-scheme/succeed/safe-letrec.rkt b/collects/tests/typed-racket/succeed/safe-letrec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/safe-letrec.rkt
rename to collects/tests/typed-racket/succeed/safe-letrec.rkt
diff --git a/collects/tests/typed-scheme/succeed/scratch.rkt b/collects/tests/typed-racket/succeed/scratch.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/scratch.rkt
rename to collects/tests/typed-racket/succeed/scratch.rkt
diff --git a/collects/tests/typed-scheme/succeed/seasoned-schemer.rkt b/collects/tests/typed-racket/succeed/seasoned-schemer.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/seasoned-schemer.rkt
rename to collects/tests/typed-racket/succeed/seasoned-schemer.rkt
diff --git a/collects/tests/typed-scheme/succeed/sequence-cnt.rkt b/collects/tests/typed-racket/succeed/sequence-cnt.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/sequence-cnt.rkt
rename to collects/tests/typed-racket/succeed/sequence-cnt.rkt
diff --git a/collects/tests/typed-scheme/succeed/sequences.rkt b/collects/tests/typed-racket/succeed/sequences.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/sequences.rkt
rename to collects/tests/typed-racket/succeed/sequences.rkt
diff --git a/collects/tests/typed-scheme/succeed/set-contract.rkt b/collects/tests/typed-racket/succeed/set-contract.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/set-contract.rkt
rename to collects/tests/typed-racket/succeed/set-contract.rkt
diff --git a/collects/tests/typed-scheme/succeed/set.rkt b/collects/tests/typed-racket/succeed/set.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/set.rkt
rename to collects/tests/typed-racket/succeed/set.rkt
diff --git a/collects/tests/typed-scheme/succeed/simple-fake-or.rkt b/collects/tests/typed-racket/succeed/simple-fake-or.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/simple-fake-or.rkt
rename to collects/tests/typed-racket/succeed/simple-fake-or.rkt
diff --git a/collects/tests/typed-scheme/succeed/simple-implies.rkt b/collects/tests/typed-racket/succeed/simple-implies.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/simple-implies.rkt
rename to collects/tests/typed-racket/succeed/simple-implies.rkt
diff --git a/collects/tests/typed-scheme/succeed/simple-kw-app.rkt b/collects/tests/typed-racket/succeed/simple-kw-app.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/simple-kw-app.rkt
rename to collects/tests/typed-racket/succeed/simple-kw-app.rkt
diff --git a/collects/tests/typed-scheme/succeed/simple-occurr.rkt b/collects/tests/typed-racket/succeed/simple-occurr.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/simple-occurr.rkt
rename to collects/tests/typed-racket/succeed/simple-occurr.rkt
diff --git a/collects/tests/typed-scheme/succeed/simple-or.rkt b/collects/tests/typed-racket/succeed/simple-or.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/simple-or.rkt
rename to collects/tests/typed-racket/succeed/simple-or.rkt
diff --git a/collects/tests/typed-scheme/succeed/simple-poly.rkt b/collects/tests/typed-racket/succeed/simple-poly.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/simple-poly.rkt
rename to collects/tests/typed-racket/succeed/simple-poly.rkt
diff --git a/collects/tests/typed-scheme/succeed/somesystempath.rkt b/collects/tests/typed-racket/succeed/somesystempath.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/somesystempath.rkt
rename to collects/tests/typed-racket/succeed/somesystempath.rkt
diff --git a/collects/tests/typed-racket/succeed/standard-features-base.rkt b/collects/tests/typed-racket/succeed/standard-features-base.rkt
new file mode 100644
index 0000000000..f3e6d4ceeb
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-base.rkt
@@ -0,0 +1,7 @@
+#lang typed/racket/base
+
+(: f (Integer -> Any))
+(define (f x) (add1 x))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-no-check-base.rkt b/collects/tests/typed-racket/succeed/standard-features-no-check-base.rkt
new file mode 100644
index 0000000000..8323187a68
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-no-check-base.rkt
@@ -0,0 +1,7 @@
+#lang typed/racket/base/no-check
+
+(: f (Integer -> Any))
+(define (f x) (add1 ""))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-no-check-scheme-base.rkt b/collects/tests/typed-racket/succeed/standard-features-no-check-scheme-base.rkt
new file mode 100644
index 0000000000..2c95d8cc2d
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-no-check-scheme-base.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme/base/no-check
+
+(: f (Integer -> Any))
+(define (f x) (add1 ""))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-no-check-scheme.rkt b/collects/tests/typed-racket/succeed/standard-features-no-check-scheme.rkt
new file mode 100644
index 0000000000..d94b0ffb00
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-no-check-scheme.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme/no-check
+
+(: f (Integer -> Any))
+(define (f x) (add1 ""))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-no-check-ts.rkt b/collects/tests/typed-racket/succeed/standard-features-no-check-ts.rkt
new file mode 100644
index 0000000000..5c13b257ca
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-no-check-ts.rkt
@@ -0,0 +1,7 @@
+#lang typed-scheme/no-check
+
+(: f (Integer -> Any))
+(define (f x) (add1 ""))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-no-check.rkt b/collects/tests/typed-racket/succeed/standard-features-no-check.rkt
new file mode 100644
index 0000000000..df409d2c7e
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-no-check.rkt
@@ -0,0 +1,7 @@
+#lang typed/racket/no-check
+
+(: f (Integer -> Any))
+(define (f x) (add1 ""))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-scheme-base.rkt b/collects/tests/typed-racket/succeed/standard-features-scheme-base.rkt
new file mode 100644
index 0000000000..498f1dad7b
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-scheme-base.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme/base
+
+(: f (Integer -> Any))
+(define (f x) (add1 x))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-scheme.rkt b/collects/tests/typed-racket/succeed/standard-features-scheme.rkt
new file mode 100644
index 0000000000..f6f3ff2d38
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-scheme.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme
+
+(: f (Integer -> Any))
+(define (f x) (add1 x))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features-ts.rkt b/collects/tests/typed-racket/succeed/standard-features-ts.rkt
new file mode 100644
index 0000000000..00782c87f9
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features-ts.rkt
@@ -0,0 +1,7 @@
+#lang typed-scheme
+
+(: f (Integer -> Any))
+(define (f x) (add1 x))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-racket/succeed/standard-features.rkt b/collects/tests/typed-racket/succeed/standard-features.rkt
new file mode 100644
index 0000000000..d99f5b89ec
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/standard-features.rkt
@@ -0,0 +1,7 @@
+#lang typed/racket
+
+(: f (Integer -> Any))
+(define (f x) (add1 x))
+
+(lambda (#{x : String}) (string-append " " x))
+
diff --git a/collects/tests/typed-scheme/succeed/star-sizes.rkt b/collects/tests/typed-racket/succeed/star-sizes.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/star-sizes.rkt
rename to collects/tests/typed-racket/succeed/star-sizes.rkt
diff --git a/collects/tests/typed-scheme/succeed/stream.rkt b/collects/tests/typed-racket/succeed/stream.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/stream.rkt
rename to collects/tests/typed-racket/succeed/stream.rkt
diff --git a/collects/tests/typed-scheme/succeed/string-const.rkt b/collects/tests/typed-racket/succeed/string-const.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/string-const.rkt
rename to collects/tests/typed-racket/succeed/string-const.rkt
diff --git a/collects/tests/typed-scheme/succeed/struct-cert.rkt b/collects/tests/typed-racket/succeed/struct-cert.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/struct-cert.rkt
rename to collects/tests/typed-racket/succeed/struct-cert.rkt
diff --git a/collects/tests/typed-scheme/succeed/struct-exec.rkt b/collects/tests/typed-racket/succeed/struct-exec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/struct-exec.rkt
rename to collects/tests/typed-racket/succeed/struct-exec.rkt
diff --git a/collects/tests/typed-scheme/succeed/struct-mutable.rkt b/collects/tests/typed-racket/succeed/struct-mutable.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/struct-mutable.rkt
rename to collects/tests/typed-racket/succeed/struct-mutable.rkt
diff --git a/collects/tests/typed-scheme/succeed/struct-out.rkt b/collects/tests/typed-racket/succeed/struct-out.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/struct-out.rkt
rename to collects/tests/typed-racket/succeed/struct-out.rkt
diff --git a/collects/tests/typed-scheme/succeed/struct-path-update.rkt b/collects/tests/typed-racket/succeed/struct-path-update.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/struct-path-update.rkt
rename to collects/tests/typed-racket/succeed/struct-path-update.rkt
diff --git a/collects/tests/typed-scheme/succeed/test-child-field.rkt b/collects/tests/typed-racket/succeed/test-child-field.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/test-child-field.rkt
rename to collects/tests/typed-racket/succeed/test-child-field.rkt
diff --git a/collects/tests/typed-scheme/succeed/test.rkt b/collects/tests/typed-racket/succeed/test.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/test.rkt
rename to collects/tests/typed-racket/succeed/test.rkt
diff --git a/collects/tests/typed-scheme/succeed/test2.rkt b/collects/tests/typed-racket/succeed/test2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/test2.rkt
rename to collects/tests/typed-racket/succeed/test2.rkt
diff --git a/collects/tests/typed-scheme/succeed/threads-and-channels.rkt b/collects/tests/typed-racket/succeed/threads-and-channels.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/threads-and-channels.rkt
rename to collects/tests/typed-racket/succeed/threads-and-channels.rkt
diff --git a/collects/tests/typed-scheme/succeed/time.rkt b/collects/tests/typed-racket/succeed/time.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/time.rkt
rename to collects/tests/typed-racket/succeed/time.rkt
diff --git a/collects/tests/typed-scheme/succeed/typeann-letrec.rkt b/collects/tests/typed-racket/succeed/typeann-letrec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/typeann-letrec.rkt
rename to collects/tests/typed-racket/succeed/typeann-letrec.rkt
diff --git a/collects/tests/typed-scheme/succeed/typed-list.rkt b/collects/tests/typed-racket/succeed/typed-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/typed-list.rkt
rename to collects/tests/typed-racket/succeed/typed-list.rkt
diff --git a/collects/tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt b/collects/tests/typed-racket/succeed/typed-scheme-no-check-arrow.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt
rename to collects/tests/typed-racket/succeed/typed-scheme-no-check-arrow.rkt
diff --git a/collects/tests/typed-scheme/succeed/unsafe-struct-parent.rkt b/collects/tests/typed-racket/succeed/unsafe-struct-parent.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/unsafe-struct-parent.rkt
rename to collects/tests/typed-racket/succeed/unsafe-struct-parent.rkt
diff --git a/collects/tests/typed-scheme/succeed/unsafe-struct.rkt b/collects/tests/typed-racket/succeed/unsafe-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/unsafe-struct.rkt
rename to collects/tests/typed-racket/succeed/unsafe-struct.rkt
diff --git a/collects/tests/typed-scheme/succeed/values-dots.rkt b/collects/tests/typed-racket/succeed/values-dots.rkt
similarity index 95%
rename from collects/tests/typed-scheme/succeed/values-dots.rkt
rename to collects/tests/typed-racket/succeed/values-dots.rkt
index f97ef0f472..efe5f3d11f 100644
--- a/collects/tests/typed-scheme/succeed/values-dots.rkt
+++ b/collects/tests/typed-racket/succeed/values-dots.rkt
@@ -1,6 +1,6 @@
 #lang typed/scheme/base
 
-(require typed-scheme/base-env/extra-procs)
+(require typed-racket/base-env/extra-procs)
 
 
 (call-with-values (lambda () (values 1 2)) (lambda: ([x : Number] [y : Number]) (+ x y)))
diff --git a/collects/tests/typed-scheme/succeed/varargs-tests.rkt b/collects/tests/typed-racket/succeed/varargs-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/varargs-tests.rkt
rename to collects/tests/typed-racket/succeed/varargs-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/vec-tests.rkt b/collects/tests/typed-racket/succeed/vec-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/vec-tests.rkt
rename to collects/tests/typed-racket/succeed/vec-tests.rkt
diff --git a/collects/tests/typed-scheme/succeed/with-asserts.rkt b/collects/tests/typed-racket/succeed/with-asserts.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/with-asserts.rkt
rename to collects/tests/typed-racket/succeed/with-asserts.rkt
diff --git a/collects/tests/typed-scheme/succeed/with-handlers.rkt b/collects/tests/typed-racket/succeed/with-handlers.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/with-handlers.rkt
rename to collects/tests/typed-racket/succeed/with-handlers.rkt
diff --git a/collects/tests/typed-scheme/succeed/with-syntax.rkt b/collects/tests/typed-racket/succeed/with-syntax.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/with-syntax.rkt
rename to collects/tests/typed-racket/succeed/with-syntax.rkt
diff --git a/collects/tests/typed-scheme/succeed/with-type.rkt b/collects/tests/typed-racket/succeed/with-type.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/with-type.rkt
rename to collects/tests/typed-racket/succeed/with-type.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/all-tests.rkt b/collects/tests/typed-racket/unit-tests/all-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/all-tests.rkt
rename to collects/tests/typed-racket/unit-tests/all-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/contract-tests.rkt b/collects/tests/typed-racket/unit-tests/contract-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/contract-tests.rkt
rename to collects/tests/typed-racket/unit-tests/contract-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/infer-tests.rkt b/collects/tests/typed-racket/unit-tests/infer-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/infer-tests.rkt
rename to collects/tests/typed-racket/unit-tests/infer-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/module-tests.rkt b/collects/tests/typed-racket/unit-tests/module-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/module-tests.rkt
rename to collects/tests/typed-racket/unit-tests/module-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt b/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
rename to collects/tests/typed-racket/unit-tests/parse-type-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/planet-requires.rkt b/collects/tests/typed-racket/unit-tests/planet-requires.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/planet-requires.rkt
rename to collects/tests/typed-racket/unit-tests/planet-requires.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.rkt b/collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/remove-intersect-tests.rkt
rename to collects/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
similarity index 91%
rename from collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt
rename to collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
index ff0d1af2c2..fc148ac1c0 100644
--- a/collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt
+++ b/collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
@@ -10,7 +10,7 @@
                                 [true-filter -true-filter]
                                 [-> t:->]))
          (except-in (utils tc-utils utils) infer)
-         typed-scheme/infer/infer-dummy typed-scheme/infer/infer
+         typed-racket/infer/infer-dummy typed-racket/infer/infer
          unstable/mutated-vars
          
          rackunit rackunit/text-ui
@@ -20,9 +20,9 @@
                      (types abbrev convenience utils)
                      unstable/mutated-vars
                      (utils tc-utils) (typecheck typechecker))
-         typed-scheme/base-env/prims
-         typed-scheme/base-env/base-types
-         (only-in typed-scheme/typed-scheme do-standard-inits))
+         typed-racket/base-env/prims
+         typed-racket/base-env/base-types
+         (only-in typed-racket/typed-racket do-standard-inits))
 
 (begin-for-syntax (do-standard-inits))
 
@@ -113,6 +113,12 @@
    [tc-e (with-handlers ([void (λ (x) (values 0 0))]) (values  "" ""))
          #:ret (ret (list (t:Un -Zero -String) (t:Un -Zero -String)))]
    
+   (tc-e (make-temporary-file) -Path)
+   (tc-e (make-temporary-file "ee~a") -Path)
+   (tc-e (make-temporary-file "ee~a" 'directory) -Path)
+   (tc-e (make-temporary-file "ee~a" "temp" "here") -Path)
+
+   
    ))
 
 
diff --git a/collects/tests/typed-scheme/unit-tests/subst-tests.rkt b/collects/tests/typed-racket/unit-tests/subst-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/subst-tests.rkt
rename to collects/tests/typed-racket/unit-tests/subst-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/subtype-tests.rkt b/collects/tests/typed-racket/unit-tests/subtype-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/subtype-tests.rkt
rename to collects/tests/typed-racket/unit-tests/subtype-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/test-utils.rkt b/collects/tests/typed-racket/unit-tests/test-utils.rkt
similarity index 98%
rename from collects/tests/typed-scheme/unit-tests/test-utils.rkt
rename to collects/tests/typed-racket/unit-tests/test-utils.rkt
index 26e3474be7..673ae4c0ab 100644
--- a/collects/tests/typed-scheme/unit-tests/test-utils.rkt
+++ b/collects/tests/typed-racket/unit-tests/test-utils.rkt
@@ -4,7 +4,7 @@
 (require scheme/require-syntax
          scheme/match
          scheme/gui/dynamic
-	 typed-scheme/utils/utils
+	 typed-racket/utils/utils
          (for-syntax scheme/base)
          (types comparison utils)
          rackunit rackunit/text-ui)
diff --git a/collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt b/collects/tests/typed-racket/unit-tests/type-annotation-test.rkt
similarity index 85%
rename from collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt
rename to collects/tests/typed-racket/unit-tests/type-annotation-test.rkt
index 6a4f73446f..7bbf7883b3 100644
--- a/collects/tests/typed-scheme/unit-tests/type-annotation-test.rkt
+++ b/collects/tests/typed-racket/unit-tests/type-annotation-test.rkt
@@ -1,8 +1,8 @@
 #lang scheme/base
 (require "test-utils.rkt"
          (for-syntax scheme/base)
-         typed-scheme/private/type-annotation
-         typed-scheme/private/parse-type
+         typed-racket/private/type-annotation
+         typed-racket/private/parse-type
          (types abbrev numeric-tower utils)
          (env type-env-structs init-envs)
          (utils tc-utils)
@@ -16,9 +16,9 @@
                           (type-ascription (let ([ons (current-namespace)]
                                                  [ns (make-base-namespace)])
                                              (parameterize ([current-namespace ns])
-                                               (namespace-require 'typed-scheme/base-env/prims)
-                                               (namespace-require 'typed-scheme/base-env/base-types)
-                                               (namespace-require 'typed-scheme/base-env/base-types-extra)
+                                               (namespace-require 'typed-racket/base-env/prims)
+                                               (namespace-require 'typed-racket/base-env/base-types)
+                                               (namespace-require 'typed-racket/base-env/base-types-extra)
                                                (expand 'ann-stx))))
                           ty))
 
diff --git a/collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt b/collects/tests/typed-racket/unit-tests/type-equal-tests.rkt
similarity index 100%
rename from collects/tests/typed-scheme/unit-tests/type-equal-tests.rkt
rename to collects/tests/typed-racket/unit-tests/type-equal-tests.rkt
diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
similarity index 99%
rename from collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
rename to collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
index 5c6cb4be16..b6a1a59abb 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -15,7 +15,7 @@
                     [true-filter -true-filter]
                     [-> t:->])
          (except-in (utils tc-utils utils) infer)
-         typed-scheme/infer/infer-dummy typed-scheme/infer/infer
+         typed-racket/infer/infer-dummy typed-racket/infer/infer
          unstable/mutated-vars
          (env type-name-env type-env-structs init-envs)
          rackunit rackunit/text-ui
@@ -134,7 +134,7 @@
 (define (typecheck-tests)
   (test-suite
    "Typechecker tests"
-   #reader typed-scheme/typed-reader
+   #reader typed-racket/typed-reader
      (test-suite
         "tc-expr tests"
 
@@ -1096,11 +1096,6 @@
 
         (tc-e (make-directory* "tmp/a/b/c") -Void)
 
-        (tc-e (make-temporary-file) -Path)
-        (tc-e (make-temporary-file "ee~a") -Path)
-        (tc-e (make-temporary-file "ee~a" 'directory) -Path)
-        (tc-e (make-temporary-file "ee~a" "temp" "here") -Path)
-
         
         (tc-e (put-preferences (list 'sym 'sym2) (list 'v1 'v2)) -Void)
 
@@ -1381,7 +1376,7 @@
 ;; these no longer work with the new scheme for top-level identifiers
 ;; could probably be revived
 #;(define (tc-toplevel-tests)
-#reader typed-scheme/typed-reader
+#reader typed-racket/typed-reader
 (test-suite "Tests for tc-toplevel"
             (tc-tl 3)
             (tc-tl (define: x : Number 4))
diff --git a/collects/tests/typed-scheme/xfail/ann-map-funcs.rkt b/collects/tests/typed-racket/xfail/ann-map-funcs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/ann-map-funcs.rkt
rename to collects/tests/typed-racket/xfail/ann-map-funcs.rkt
diff --git a/collects/tests/typed-scheme/xfail/applicative.rkt b/collects/tests/typed-racket/xfail/applicative.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/applicative.rkt
rename to collects/tests/typed-racket/xfail/applicative.rkt
diff --git a/collects/tests/typed-scheme/xfail/apply-map-bug.rkt b/collects/tests/typed-racket/xfail/apply-map-bug.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/apply-map-bug.rkt
rename to collects/tests/typed-racket/xfail/apply-map-bug.rkt
diff --git a/collects/tests/typed-scheme/xfail/cl-expected.rkt b/collects/tests/typed-racket/xfail/cl-expected.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/cl-expected.rkt
rename to collects/tests/typed-racket/xfail/cl-expected.rkt
diff --git a/collects/tests/typed-scheme/xfail/for-inference.rkt b/collects/tests/typed-racket/xfail/for-inference.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/for-inference.rkt
rename to collects/tests/typed-racket/xfail/for-inference.rkt
diff --git a/collects/tests/typed-scheme/xfail/pr10618.rkt b/collects/tests/typed-racket/xfail/pr10618.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/pr10618.rkt
rename to collects/tests/typed-racket/xfail/pr10618.rkt
diff --git a/collects/tests/typed-scheme/xfail/priority-queue.scm b/collects/tests/typed-racket/xfail/priority-queue.scm
similarity index 100%
rename from collects/tests/typed-scheme/xfail/priority-queue.scm
rename to collects/tests/typed-racket/xfail/priority-queue.scm
diff --git a/collects/tests/typed-scheme/xfail/rec-contract.rkt b/collects/tests/typed-racket/xfail/rec-contract.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/rec-contract.rkt
rename to collects/tests/typed-racket/xfail/rec-contract.rkt
diff --git a/collects/tests/typed-scheme/xfail/unholy-terror.rkt b/collects/tests/typed-racket/xfail/unholy-terror.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/unholy-terror.rkt
rename to collects/tests/typed-racket/xfail/unholy-terror.rkt
diff --git a/collects/tests/typed-scheme/xfail/xmodule-mutation.rkt b/collects/tests/typed-racket/xfail/xmodule-mutation.rkt
similarity index 100%
rename from collects/tests/typed-scheme/xfail/xmodule-mutation.rkt
rename to collects/tests/typed-racket/xfail/xmodule-mutation.rkt
diff --git a/collects/tests/typed-scheme/nightly-run.rkt b/collects/tests/typed-scheme/nightly-run.rkt
deleted file mode 100644
index d4798e5a07..0000000000
--- a/collects/tests/typed-scheme/nightly-run.rkt
+++ /dev/null
@@ -1,8 +0,0 @@
-#lang scheme/base
-
-(require scheme/runtime-path)
-(define-runtime-path run "run.rkt")
-(if (eq? 'cgc (system-type 'gc))
-  (printf "Running under CGC => skipping tests\n")
-  (parameterize ([current-command-line-arguments '#("--nightly")])
-    (dynamic-require run #f)))
diff --git a/collects/tests/unstable/syntax.rkt b/collects/tests/unstable/syntax.rkt
index 242a87382f..2ea1317080 100644
--- a/collects/tests/unstable/syntax.rkt
+++ b/collects/tests/unstable/syntax.rkt
@@ -4,6 +4,7 @@
          rackunit
          rackunit/text-ui
          racket/syntax
+         (for-syntax unstable/syntax)
          unstable/syntax
          "helpers.rkt")
 
@@ -56,19 +57,25 @@
                 (with-syntax* ([a #'id] [b #'a]) #'b)
                 #'id))))
 
-   (test-suite "syntax-within?"
-     (let* ([a #'a]
-            [b #'b]
-            [c #'(a b c)]
-            [c1 (car (syntax->list c))]
-            [c2 (cadr (syntax->list c))])
-       (test-case "reflexive"
-         (check-equal? (syntax-within? a a) #t))
-       (test-case "unrelated"
-         (check-equal? (syntax-within? a b) #f))
-       (test-case "child"
-         (check-equal? (syntax-within? c1 c) #t))
-       (test-case "parent"
-         (check-equal? (syntax-within? c c1) #f))
-       (test-case "sibling"
-         (check-equal? (syntax-within? c2 c1) #f))))))
+   (let ()
+     (define-syntax a #'a)
+     (define-syntax b #'b)
+     (define-syntax c #'(a b c))
+     (define-syntax c1 (car (syntax->list (syntax-local-value #'c))))
+     (define-syntax c2 (cadr (syntax->list (syntax-local-value #'c))))
+     (define-syntax (*syntax-within? stx)
+       (syntax-case stx ()
+         [(_ x y)
+          #`#,(syntax-within? (syntax-local-value #'x)
+                              (syntax-local-value #'y))]))
+     (test-suite "syntax-within?"
+                 (test-case "reflexive"
+                            (check-equal? (*syntax-within? a a) #t))
+                 (test-case "unrelated"
+                            (check-equal? (*syntax-within? a b) #f))
+                 (test-case "child"
+                            (check-equal? (*syntax-within? c1 c) #t))
+                 (test-case "parent"
+                            (check-equal? (*syntax-within? c c1) #f))
+                 (test-case "sibling"
+                            (check-equal? (*syntax-within? c2 c1) #f))))))
diff --git a/collects/tests/web-server/dispatchers/dispatch-files-test.rkt b/collects/tests/web-server/dispatchers/dispatch-files-test.rkt
index a42f645af2..58e3110408 100644
--- a/collects/tests/web-server/dispatchers/dispatch-files-test.rkt
+++ b/collects/tests/web-server/dispatchers/dispatch-files-test.rkt
@@ -80,22 +80,22 @@
    
    (test-equal?* "file, exists, whole, no Range, get"
                 (collect (dispatch #t tmp-file) (req #f #"GET" empty))
-                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
+                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
    (test-equal?* "file, exists, whole, no Range, head"
                 (collect (dispatch #t tmp-file) (req #f #"HEAD" empty))
-                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n")
+                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n")
    (test-equal?* "file, exists, whole, Range, get"
                 (collect (dispatch #t tmp-file) (req #f #"GET" (list (make-header #"Range" #"bytes=0-80"))))
-                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
+                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
    (test-equal?* "file, exists, whole, Range, head"
                 (collect (dispatch #t tmp-file) (req #f #"HEAD" (list (make-header #"Range" #"bytes=0-80"))))
-                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
+                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
    (test-equal?* "file, exists, part, get"
                 (collect (dispatch #t tmp-file) (req #f #"GET" (list (make-header #"Range" #"bytes=5-9"))))
-                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 5-9/81\r\n\r\n><hea")
+                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 5-9/81\r\n\r\n><hea")
    (test-equal?* "file, exists, part, head"
                 (collect (dispatch #t tmp-file) (req #f #"HEAD" (list (make-header #"Range" #"bytes=5-9"))))
-                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 5-9/81\r\n\r\n")
+                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 5-9/81\r\n\r\n")
    
    (test-exn "path, non"
              exn:dispatcher?
@@ -103,16 +103,16 @@
    
    (test-equal?* "dir, exists, no Range, get"
                 (collect (dispatch #t a-dir) (req #t #"GET" empty))
-                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
+                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
    (test-equal?* "dir, exists, no Range, head"
                 (collect (dispatch #t a-dir) (req #t #"HEAD" empty))
-                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n")
+                #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n")
    (test-equal?* "dir, exists, Range, get"
                 (collect (dispatch #t a-dir) (req #t #"GET" (list (make-header #"Range" #"bytes=0-80"))))
-                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
+                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
    (test-equal?* "dir, exists, Range, head"
                 (collect (dispatch #t a-dir) (req #t #"HEAD" (list (make-header #"Range" #"bytes=0-80"))))
-                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
+                #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
    (test-equal?* "dir, not dir-url, get"
                 (collect (dispatch #t a-dir) (req #f #"GET" empty))
                 #"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nLocation: /foo/\r\n\r\n")
diff --git a/collects/tests/web-server/private/mime-types-test.rkt b/collects/tests/web-server/private/mime-types-test.rkt
index 91566d0152..708c883ec4 100644
--- a/collects/tests/web-server/private/mime-types-test.rkt
+++ b/collects/tests/web-server/private/mime-types-test.rkt
@@ -28,7 +28,7 @@ END
     (check-not-false (read-mime-types test-file)))
    (test-case
     "Default mime-type given"
-    (check-equal? ((make-path->mime-type test-file) (build-path "test.html")) TEXT/HTML-MIME-TYPE))
+    (check-equal? ((make-path->mime-type test-file) (build-path "test.html")) #f))
    (test-case
     "MIME type resolves (single in file)"
     (check-equal? ((make-path->mime-type test-file) (build-path "test.mp4")) #"video/mp4"))
diff --git a/collects/tests/web-server/private/response-test.rkt b/collects/tests/web-server/private/response-test.rkt
index 9517a57b61..130043568d 100644
--- a/collects/tests/web-server/private/response-test.rkt
+++ b/collects/tests/web-server/private/response-test.rkt
@@ -36,6 +36,11 @@
                           (response 404 #"404" (current-seconds) #"text/html"
                                     (list) void))
                   #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n")
+     (test-equi? "response" 
+                  (output output-response 
+                          (response 404 #"404" (current-seconds) #f
+                                    (list) void))
+                  #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nConnection: close\r\n\r\n")
      (test-equi? "response (header)" 
                   (output output-response 
                           (response 404 #"404" (current-seconds) #"text/html"
@@ -55,7 +60,13 @@
                   (output output-response 
                           (response 404 #"404" (current-seconds) #"text/html"
                                     (list (make-header #"Header" #"Value")) void))
-                  #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value\r\n\r\n"))
+                  #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value\r\n\r\n")
+     (test-equi? "response (both)" 
+                  (output output-response 
+                          (response 404 #"404" (current-seconds) #"text/html"
+                                    (list (make-header #"Header" #"Value1")
+                                          (make-header #"Header" #"Value2")) void))
+                  #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value1\r\nHeader: Value2\r\n\r\n"))
     
     (test-suite 
      "response/full"
@@ -225,12 +236,12 @@
       
       (test-equi? "(get) multiple ranges"
                    (output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (30 . 39) (50 . 59)) #"BOUNDARY")
-                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 260\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 50-59/81\r\n\r\ne's some c\r\n--BOUNDARY--\r\n")
+                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 266\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 50-59/81\r\n\r\ne's some c\r\n\r\n--BOUNDARY--\r\n")
       
       (test-equi? "(get) some bad ranges"
                   (parameterize ([current-error-port (open-output-nowhere)])
                    (output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY"))
-                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 178\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n--BOUNDARY--\r\n")
+                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 182\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n\r\n--BOUNDARY--\r\n")
       
       (test-equi? "(get) all bad ranges"
                   (parameterize ([current-error-port (open-output-nowhere)])
@@ -275,11 +286,11 @@
       
       (test-equi? "(head) multiple ranges"
                    (output output-file/boundary tmp-file #"HEAD" #"text/html" '((10 . 19) (30 . 39) (50 . 59)) #"BOUNDARY")
-                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 260\r\n\r\n")
+                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 266\r\n\r\n")
       
       (test-equi? "(head) some bad ranges"
                    (output output-file/boundary tmp-file #"HEAD" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY")
-                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 178\r\n\r\n")
+                   #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 182\r\n\r\n")
       
       (test-equi? "(head) all bad ranges"
                   (parameterize ([current-error-port (open-output-nowhere)])
@@ -295,4 +306,4 @@
                      (get-output-string os))
                   "convert-http-ranges: No satisfiable ranges in ((-10 . -5) (1000 . 1050) (50 . 49))/81.")
       
-      ))))
\ No newline at end of file
+      ))))
diff --git a/collects/typed-scheme/base-env/annotate-classes.rkt b/collects/typed-racket/base-env/annotate-classes.rkt
similarity index 98%
rename from collects/typed-scheme/base-env/annotate-classes.rkt
rename to collects/typed-racket/base-env/annotate-classes.rkt
index 7ef0a8130e..515d23dab0 100644
--- a/collects/typed-scheme/base-env/annotate-classes.rkt
+++ b/collects/typed-racket/base-env/annotate-classes.rkt
@@ -1,6 +1,7 @@
-#lang scheme/base
+#lang racket/base
 
-(require syntax/parse "colon.rkt" (for-template "colon.rkt") "../private/parse-type.rkt")
+(require syntax/parse "../private/parse-classes.rkt"
+         (for-template "colon.rkt"))
 (provide (all-defined-out))
 
 (define-splicing-syntax-class annotated-name
diff --git a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt b/collects/typed-racket/base-env/base-env-indexing-abs.rkt
similarity index 95%
rename from collects/typed-scheme/base-env/base-env-indexing-abs.rkt
rename to collects/typed-racket/base-env/base-env-indexing-abs.rkt
index 9812977fa8..ac1c76c32d 100644
--- a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt
+++ b/collects/typed-racket/base-env/base-env-indexing-abs.rkt
@@ -1,24 +1,17 @@
-#lang racket
+#lang racket/base
 
 (require
  "../utils/utils.rkt"
- (for-template '#%paramz racket/base racket/list
-               racket/tcp
-               (only-in rnrs/lists-6 fold-left)
-               '#%paramz
-               (only-in '#%kernel [apply kernel:apply])
-               racket/promise racket/system
-               (only-in string-constants/private/only-once maybe-print-message)
-               (only-in racket/match/runtime match:error matchable? match-equality-test)
-               racket/unsafe/ops racket/flonum)
- (utils tc-utils)
- (types union convenience)
- (rename-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym]))
+ (for-template racket/base racket/list racket/unsafe/ops racket/flonum)
+ (utils tc-utils) 
+ (rename-in (types union convenience abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym]))
 
 (provide indexing)
 
+(define-syntax-rule (make-env* [i t] ...) (make-env [i (λ () t)] ...))
+
 (define-syntax-rule (indexing index-type)
-  (make-env
+  (make-env*
 
    [build-list (-poly (a) (index-type (-Index . -> . a) . -> . (-lst a)))]
    [make-list (-poly (a) (index-type a . -> . (-lst a)))]
@@ -129,7 +122,7 @@
           [N       index-type]
           [?N      (-opt index-type)]
           [-Input (Un -String -Input-Port -Bytes -Path)])
-       (-Pattern -Input [N ?N ?outp -Bytes] . ->opt . -Boolean))]
+       (-Pattern -Input [N ?N ?outp -Bytes] . ->opt . B))]
 
 
 
diff --git a/collects/typed-scheme/base-env/base-env-indexing.rkt b/collects/typed-racket/base-env/base-env-indexing.rkt
similarity index 100%
rename from collects/typed-scheme/base-env/base-env-indexing.rkt
rename to collects/typed-racket/base-env/base-env-indexing.rkt
diff --git a/collects/typed-scheme/base-env/base-env-numeric.rkt b/collects/typed-racket/base-env/base-env-numeric.rkt
similarity index 72%
rename from collects/typed-scheme/base-env/base-env-numeric.rkt
rename to collects/typed-racket/base-env/base-env-numeric.rkt
index fc42e8caae..cb25ff614b 100644
--- a/collects/typed-scheme/base-env/base-env-numeric.rkt
+++ b/collects/typed-racket/base-env/base-env-numeric.rkt
@@ -78,461 +78,503 @@
 
 
   (define round-type ; also used for truncate
-    (from-cases
-     (map unop all-int-types)
-     (-> -NonNegRat -Nat)
-     (-> -NonPosRat -NonPosInt)
-     (-> -Rat -Int)
-     (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
-                     -NonNegFlonum -NonPosFlonum -Flonum
-                     -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumZero
-                     -NonNegSingleFlonum -NonPosSingleFlonum -SingleFlonum
-                     -InexactRealPosZero -InexactRealNegZero -InexactRealZero
-                     -NonNegInexactReal -NonPosInexactReal -InexactReal
-                     -RealZero -NonNegReal -NonPosReal -Real))))
+    (lambda ()
+      (from-cases
+       (map unop all-int-types)
+       (-> -NonNegRat -Nat)
+       (-> -NonPosRat -NonPosInt)
+       (-> -Rat -Int)
+       (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
+                       -NonNegFlonum -NonPosFlonum -Flonum
+                       -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumZero
+                       -NonNegSingleFlonum -NonPosSingleFlonum -SingleFlonum
+                       -InexactRealPosZero -InexactRealNegZero -InexactRealZero
+                       -NonNegInexactReal -NonPosInexactReal -InexactReal
+                       -RealZero -NonNegReal -NonPosReal -Real)))))
 
-  (define fl-unop (unop -Flonum))
+  (define fl-unop (lambda () (unop -Flonum)))
 
   ;; types for specific operations, to avoid repetition between safe and unsafe versions
   (define fx+-type
-    (fx-from-cases
-     (binop -Zero)
-     (map (lambda (t) (commutative-binop t -Zero t))
-          (list -One -PosByte -Byte -PosIndex -Index))
-     (commutative-binop -PosByte -Byte -PosIndex)
-     (-Byte -Byte . -> . -PosIndex)
-     ;; in other cases, either we stay within fixnum range, or we error
-     (commutative-binop -Pos -Nat -PosFixnum)
-     (-Nat -Nat . -> . -NonNegFixnum)
-     (commutative-binop -NegInt -One -NonPosFixnum)
-     (commutative-binop -NegInt -NonPosInt -NegFixnum)
-     (-NonPosInt -NonPosInt . -> . -NonPosFixnum)
-     (-Int -Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (binop -Zero)
+       (map (lambda (t) (commutative-binop t -Zero t))
+            (list -One -PosByte -Byte -PosIndex -Index))
+       (commutative-binop -PosByte -Byte -PosIndex)
+       (-Byte -Byte . -> . -PosIndex)
+       ;; in other cases, either we stay within fixnum range, or we error
+       (commutative-binop -Pos -Nat -PosFixnum)
+       (-Nat -Nat . -> . -NonNegFixnum)
+       (commutative-binop -NegInt -One -NonPosFixnum)
+       (commutative-binop -NegInt -NonPosInt -NegFixnum)
+       (-NonPosInt -NonPosInt . -> . -NonPosFixnum)
+       (-Int -Int . -> . -Fixnum))))
   (define fx--type
-    (fx-from-cases
-     (binop -Zero)
-     (map (lambda (t) (commutative-binop t -Zero t))
-          (list -One -PosByte -Byte -PosIndex -Index))
-     (-One -One . -> . -Zero)
-     (-PosByte -One . -> . -Byte)
-     (-PosIndex -One . -> . -Index)
-     (-PosFixnum -One . -> . -NonNegFixnum)
-     (-NegInt -Nat . -> . -NegFixnum)
-     (-NonPosInt -PosInt . -> . -NegFixnum)
-     (-NonPosInt -Nat . -> . -NonPosFixnum)
-     (-PosInt -NonPosInt . -> . -PosInt)
-     (-Nat -NegInt . -> . -PosInt)
-     (-Nat -NonPosInt . -> . -Nat)
-     (-Int -Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (binop -Zero)
+       (map (lambda (t) (commutative-binop t -Zero t))
+            (list -One -PosByte -Byte -PosIndex -Index))
+       (-One -One . -> . -Zero)
+       (-PosByte -One . -> . -Byte)
+       (-PosIndex -One . -> . -Index)
+       (-PosFixnum -One . -> . -NonNegFixnum)
+       (-NegInt -Nat . -> . -NegFixnum)
+       (-NonPosInt -PosInt . -> . -NegFixnum)
+       (-NonPosInt -Nat . -> . -NonPosFixnum)
+       (-PosInt -NonPosInt . -> . -PosInt)
+       (-Nat -NegInt . -> . -PosInt)
+       (-Nat -NonPosInt . -> . -Nat)
+       (-Int -Int . -> . -Fixnum))))
   (define fx*-type
-    (fx-from-cases
-     (map binop (list -Zero -One))
-     (commutative-binop -Zero -Int)
-     (-PosByte -PosByte . -> . -PosIndex)
-     (-Byte -Byte . -> . -Index)
-     (-PosInt -PosInt . -> . -PosFixnum)
-     (commutative-binop -PosInt -NegInt -NegFixnum)
-     (-NegInt -NegInt . -> . -PosFixnum)
-     (-Nat -Nat . -> . -NonNegFixnum)
-     (commutative-binop -Nat -NonPosInt -NonPosFixnum)
-     (-NonPosFixnum -NonPosFixnum . -> . -NonNegFixnum)
-     (-Int -Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (map binop (list -Zero -One))
+       (commutative-binop -Zero -Int)
+       (-PosByte -PosByte . -> . -PosIndex)
+       (-Byte -Byte . -> . -Index)
+       (-PosInt -PosInt . -> . -PosFixnum)
+       (commutative-binop -PosInt -NegInt -NegFixnum)
+       (-NegInt -NegInt . -> . -PosFixnum)
+       (-Nat -Nat . -> . -NonNegFixnum)
+       (commutative-binop -Nat -NonPosInt -NonPosFixnum)
+       (-NonPosFixnum -NonPosFixnum . -> . -NonNegFixnum)
+       (-Int -Int . -> . -Fixnum))))
   (define fxquotient-type
-    (fx-from-cases
-     (-Zero -Int . -> . -Zero)
-     (map (lambda (t) (-> t -One t)) ; division by one is identity
-          (list -PosByte -Byte -PosIndex -Index
-                -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum))
-     (-Byte -Nat . -> . -Byte)
-     (-Index -Nat . -> . -Index)
-     (-Nat -Nat . -> . -NonNegFixnum)
-     (commutative-binop -Nat -NonPosInt -NonPosFixnum)
-     (-NonPosInt -NonPosInt . -> . -NonNegFixnum)
-     (-Int -Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (-Zero -Int . -> . -Zero)
+       (map (lambda (t) (-> t -One t)) ; division by one is identity
+            (list -PosByte -Byte -PosIndex -Index
+                  -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum))
+       (-Byte -Nat . -> . -Byte)
+       (-Index -Nat . -> . -Index)
+       (-Nat -Nat . -> . -NonNegFixnum)
+       (commutative-binop -Nat -NonPosInt -NonPosFixnum)
+       (-NonPosInt -NonPosInt . -> . -NonNegFixnum)
+       (-Int -Int . -> . -Fixnum))))
   (define fxremainder-type ; result has same sign as first arg
-    (fx-from-cases
-     (-One -One . -> . -Zero)
-     (map (lambda (t) (list (-> -Nat t t)
-                            (-> t -Int t)))
-          (list -Byte -Index))
-     (-Nat -Int . -> . -NonNegFixnum)
-     (-NonPosInt -Int . -> . -NonPosFixnum)
-     (-Int -Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (-One -One . -> . -Zero)
+       (map (lambda (t) (list (-> -Nat t t)
+                              (-> t -Int t)))
+            (list -Byte -Index))
+       (-Nat -Int . -> . -NonNegFixnum)
+       (-NonPosInt -Int . -> . -NonPosFixnum)
+       (-Int -Int . -> . -Fixnum))))
   (define fxmodulo-type ; result has same sign as second arg
-    (fx-from-cases
-     (-One -One . -> . -Zero)
-     (map (lambda (t) (list (-> -Int t t)
-                            (-> t -Nat t)))
-          (list -Byte -Index))
-     (-Int -Nat . -> . -NonNegFixnum)
-     (-Int -NonPosInt . -> . -NonPosFixnum)
-     (-Int -Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (-One -One . -> . -Zero)
+       (map (lambda (t) (list (-> -Int t t)
+                              (-> t -Nat t)))
+            (list -Byte -Index))
+       (-Int -Nat . -> . -NonNegFixnum)
+       (-Int -NonPosInt . -> . -NonPosFixnum)
+       (-Int -Int . -> . -Fixnum))))
   (define fxabs-type
-    (fx-from-cases
-     (map unop (list -Zero -One -PosByte -Byte -PosIndex -Index))
-     ((Un -PosInt -NegInt) . -> . -PosFixnum)
-     (-Int . -> . -NonNegFixnum)))
+    (lambda ()
+      (fx-from-cases
+       (map unop (list -Zero -One -PosByte -Byte -PosIndex -Index))
+       ((Un -PosInt -NegInt) . -> . -PosFixnum)
+       (-Int . -> . -NonNegFixnum))))
   (define fx=-type
-    (fx-from-cases
-     ;; we could rule out cases like (= Pos Neg), but we currently don't
-     (map (lambda (l) (apply exclude-zero l))
-          (list (list -Byte -PosByte)
-                (list -Index -PosIndex)
-                (list -Nat -PosFixnum)
-                (list -NonPosInt -NegFixnum)
-                (list -Int (Un -PosFixnum -NegFixnum))))
-     (map (lambda (t) (commutative-equality/filter -Int t))
-          (list -One -PosByte -Byte -PosIndex -Index -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum))
-     (comp -Int)))
+    (lambda ()
+      (fx-from-cases
+       ;; we could rule out cases like (= Pos Neg), but we currently don't
+       (map (lambda (l) (apply exclude-zero l))
+            (list (list -Byte -PosByte)
+                  (list -Index -PosIndex)
+                  (list -Nat -PosFixnum)
+                  (list -NonPosInt -NegFixnum)
+                  (list -Int (Un -PosFixnum -NegFixnum))))
+       (map (lambda (t) (commutative-equality/filter -Int t))
+            (list -One -PosByte -Byte -PosIndex -Index -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum))
+       (comp -Int))))
   (define fx<-type
-    (fx-from-cases
-     (-> -Pos -One B : (-FS (-filter (Un) 0) -top)) ; can't happen
-     (-> -Nat -One B : (-FS (-filter -Zero 0) -top))
-     (-> -Int -One B : (-FS (-filter -NonPosFixnum 0) (-filter -PosFixnum 0)))
-     ;; bleh, this repeats cases below, but since we can only match a single
-     ;; case, we need to put it here as well, or we would not gain that info,
-     ;; as another unrelated case would match
-     (-> -Byte -Zero B : (-FS (-filter (Un) 0) -top))
-     (-> -Byte -One B : (-FS (-filter -Zero 0) -top))
-     (-> -Zero -Byte B : (-FS (-filter -PosByte 1) (-filter -Zero 1)))
-     (-> -Byte -PosByte B : (-FS -top (-filter -PosByte 0)))
-     (-> -Byte -Byte B : (-FS (-filter -PosByte 1) -top))
-     (-> -Pos -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -Byte -Pos B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -Nat -Byte B : (-FS (-and (-filter -Byte 0) (-filter -PosByte 1)) -top))
-     (-> -Byte -Nat B : (-FS -top (-filter -Byte 1)))
-     (-> -Index -Zero B : (-FS (-filter (Un) 0) -top))
-     (-> -Index -One B : (-FS (-filter -Zero 0) -top))
-     (-> -Zero -Index B : (-FS (-filter -PosIndex 1) (-filter -Zero 1)))
-     (-> -Index -PosIndex B : (-FS -top (-filter -PosIndex 0)))
-     (-> -Index -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -Nat -Index B : (-FS (-and (-filter -Index 0) (-filter -PosIndex 1)) -top))
-     (-> -Index -Nat B : (-FS -top (-filter -Index 1)))
-     ;; general integer cases
-     (-> -Int -Zero B : (-FS (-filter -NegFixnum 0) (-filter -NonNegFixnum 0)))
-     (-> -Zero -Int B : (-FS (-filter -PosFixnum 1) (-filter -NonPosFixnum 1)))
-     (-> -Int -PosInt B : (-FS -top (-filter -PosFixnum 0)))
-     (-> -Int -Nat B : (-FS -top (-filter -NonNegFixnum 0)))
-     (-> -Nat -Int B : (-FS (-filter -PosFixnum 1) -top))
-     (-> -Int -NonPosInt B : (-FS (-filter -NegFixnum 0) -top))
-     (-> -NegInt -Int B : (-FS -top (-filter -NegFixnum 1)))
-     (-> -NonPosInt -Int B : (-FS -top (-filter -NonPosFixnum 1)))
-     (comp -Int)))
+    (lambda ()
+      (fx-from-cases
+       (-> -Pos -One B : (-FS (-filter (Un) 0) -top)) ; can't happen
+       (-> -Nat -One B : (-FS (-filter -Zero 0) -top))
+       (-> -Int -One B : (-FS (-filter -NonPosFixnum 0) (-filter -PosFixnum 0)))
+       ;; bleh, this repeats cases below, but since we can only match a single
+       ;; case, we need to put it here as well, or we would not gain that info,
+       ;; as another unrelated case would match
+       (-> -Byte -Zero B : (-FS (-filter (Un) 0) -top))
+       (-> -Byte -One B : (-FS (-filter -Zero 0) -top))
+       (-> -Zero -Byte B : (-FS (-filter -PosByte 1) (-filter -Zero 1)))
+       (-> -Byte -PosByte B : (-FS -top (-filter -PosByte 0)))
+       (-> -Byte -Byte B : (-FS (-filter -PosByte 1) -top))
+       (-> -Pos -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
+       (-> -Byte -Pos B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
+       (-> -Nat -Byte B : (-FS (-and (-filter -Byte 0) (-filter -PosByte 1)) -top))
+       (-> -Byte -Nat B : (-FS -top (-filter -Byte 1)))
+       (-> -Index -Zero B : (-FS (-filter (Un) 0) -top))
+       (-> -Index -One B : (-FS (-filter -Zero 0) -top))
+       (-> -Zero -Index B : (-FS (-filter -PosIndex 1) (-filter -Zero 1)))
+       (-> -Index -PosIndex B : (-FS -top (-filter -PosIndex 0)))
+       (-> -Index -Index B : (-FS (-filter -PosIndex 1) -top))
+       (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
+       (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
+       (-> -Nat -Index B : (-FS (-and (-filter -Index 0) (-filter -PosIndex 1)) -top))
+       (-> -Index -Nat B : (-FS -top (-filter -Index 1)))
+       ;; general integer cases
+       (-> -Int -Zero B : (-FS (-filter -NegFixnum 0) (-filter -NonNegFixnum 0)))
+       (-> -Zero -Int B : (-FS (-filter -PosFixnum 1) (-filter -NonPosFixnum 1)))
+       (-> -Int -PosInt B : (-FS -top (-filter -PosFixnum 0)))
+       (-> -Int -Nat B : (-FS -top (-filter -NonNegFixnum 0)))
+       (-> -Nat -Int B : (-FS (-filter -PosFixnum 1) -top))
+       (-> -Int -NonPosInt B : (-FS (-filter -NegFixnum 0) -top))
+       (-> -NegInt -Int B : (-FS -top (-filter -NegFixnum 1)))
+       (-> -NonPosInt -Int B : (-FS -top (-filter -NonPosFixnum 1)))
+       (comp -Int))))
   (define fx>-type
-    (fx-from-cases
-     (-> -One -Pos B : (-FS (-filter (Un) 1) -top)) ; can't happen
-     (-> -One -Nat B : (-FS (-filter -Zero 1) -top))
-     (-> -One -Int B : (-FS (-filter -NonPosFixnum 1) (-filter -PosFixnum 1)))
-     (-> -Byte -Zero B : (-FS (-filter -PosByte 0) (-filter -Zero 0)))
-     (-> -Zero -Byte B : (-FS (-filter (Un) 1) -top))
-     (-> -One -Byte B : (-FS (-filter -Zero 1) (-filter -PosByte 1)))
-     (-> -PosByte -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Byte -Byte B : (-FS (-filter -PosByte 0) -top))
-     (-> -Byte -Pos B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -Pos -Byte B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -Byte -Nat B : (-FS (-and (-filter -PosByte 0) (-filter -Byte 1)) -top))
-     (-> -Nat -Byte B : (-FS -top (-filter -Byte 0)))
-     (-> -Zero -Index B : (-FS (-filter (Un) 1) -top))
-     (-> -One -Index B : (-FS (-filter -Zero 1) -top))
-     (-> -Index -Zero B : (-FS (-filter -PosIndex 0) (-filter -Zero 0)))
-     (-> -PosIndex -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Index -Index B : (-FS (-filter -PosIndex 0) -top))
-     (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -Index -Nat B : (-FS (-and (-filter -PosIndex 0) (-filter -Index 1)) -top))
-     (-> -Nat -Index B : (-FS -top (-filter -Index 0)))
-     ;; general integer cases
-     (-> -Zero -Int B : (-FS (-filter -NegFixnum 1) (-filter -NonNegFixnum 1)))
-     (-> -Int -Zero  B : (-FS (-filter -PosFixnum 0) (-filter -NonPosFixnum 0)))
-     (-> -PosInt -Int B : (-FS -top (-filter -PosFixnum 1)))
-     (-> -Nat -Int B : (-FS -top (-filter -NonNegFixnum 1)))
-     (-> -Int -Nat B : (-FS (-filter -PosFixnum 0) -top))
-     (-> -NonPosInt -Int B : (-FS (-filter -NegFixnum 1) -top))
-     (-> -Int -NegInt B : (-FS -top (-filter -NegFixnum 0)))
-     (-> -Int -NonPosInt B : (-FS -top (-filter -NonPosFixnum 0)))
-     (comp -Int)))
+    (lambda ()
+      (fx-from-cases
+       (-> -One -Pos B : (-FS (-filter (Un) 1) -top)) ; can't happen
+       (-> -One -Nat B : (-FS (-filter -Zero 1) -top))
+       (-> -One -Int B : (-FS (-filter -NonPosFixnum 1) (-filter -PosFixnum 1)))
+       (-> -Byte -Zero B : (-FS (-filter -PosByte 0) (-filter -Zero 0)))
+       (-> -Zero -Byte B : (-FS (-filter (Un) 1) -top))
+       (-> -One -Byte B : (-FS (-filter -Zero 1) (-filter -PosByte 1)))
+       (-> -PosByte -Byte B : (-FS -top (-filter -PosByte 1)))
+       (-> -Byte -Byte B : (-FS (-filter -PosByte 0) -top))
+       (-> -Byte -Pos B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
+       (-> -Pos -Byte B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
+       (-> -Byte -Nat B : (-FS (-and (-filter -PosByte 0) (-filter -Byte 1)) -top))
+       (-> -Nat -Byte B : (-FS -top (-filter -Byte 0)))
+       (-> -Zero -Index B : (-FS (-filter (Un) 1) -top))
+       (-> -One -Index B : (-FS (-filter -Zero 1) -top))
+       (-> -Index -Zero B : (-FS (-filter -PosIndex 0) (-filter -Zero 0)))
+       (-> -PosIndex -Index B : (-FS -top (-filter -PosIndex 1)))
+       (-> -Index -Index B : (-FS (-filter -PosIndex 0) -top))
+       (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
+       (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
+       (-> -Index -Nat B : (-FS (-and (-filter -PosIndex 0) (-filter -Index 1)) -top))
+       (-> -Nat -Index B : (-FS -top (-filter -Index 0)))
+       ;; general integer cases
+       (-> -Zero -Int B : (-FS (-filter -NegFixnum 1) (-filter -NonNegFixnum 1)))
+       (-> -Int -Zero  B : (-FS (-filter -PosFixnum 0) (-filter -NonPosFixnum 0)))
+       (-> -PosInt -Int B : (-FS -top (-filter -PosFixnum 1)))
+       (-> -Nat -Int B : (-FS -top (-filter -NonNegFixnum 1)))
+       (-> -Int -Nat B : (-FS (-filter -PosFixnum 0) -top))
+       (-> -NonPosInt -Int B : (-FS (-filter -NegFixnum 1) -top))
+       (-> -Int -NegInt B : (-FS -top (-filter -NegFixnum 0)))
+       (-> -Int -NonPosInt B : (-FS -top (-filter -NonPosFixnum 0)))
+       (comp -Int))))
   (define fx<=-type
-    (fx-from-cases
-     (-> -Pos -One B : (-FS (-filter -One 0) -top))
-     (-> -Byte -Zero B : (-FS (-filter -Zero 0) (-filter -PosByte 0)))
-     (-> -Zero -Byte B : (-FS -top (-filter (Un) 1)))
-     (-> -One -Byte B : (-FS (-filter -PosByte 1) (-filter -Zero 1)))
-     (-> -PosByte -Byte B : (-FS (-filter -PosByte 1) -top))
-     (-> -Byte -Byte B : (-FS -top (-filter -PosByte 0)))
-     (-> -Pos -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -Byte -Pos B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -Nat -Byte B : (-FS (-filter -Byte 0) -top))
-     (-> -Byte -Nat B : (-FS -top (-and (-filter -PosByte 0) (-filter -Byte 1))))
-     (-> -Index -Zero B : (-FS (-filter -Zero 0) (-filter -PosIndex 0)))
-     (-> -Zero -Index B : (-FS -top (-filter (Un) 1)))
-     (-> -One -Index B : (-FS (-filter -PosIndex 1) (-filter -Zero 1)))
-     (-> -PosIndex -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -Index -Index B : (-FS -top (-filter -PosIndex 0)))
-     (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -Nat -Index B : (-FS (-filter -Index 0) -top))
-     (-> -Index -Nat B : (-FS -top (-and (-filter -PosIndex 0) (-filter -Index 1))))
-     ;; general integer cases
-     (-> -Nat -Zero B : (-FS (-filter -Zero 0) -top))
-     (-> -One -Nat B : (-FS (-filter -PosFixnum 1) (-filter -Zero 1)))
-     (-> -Int -Zero B : (-FS (-filter -NonPosFixnum 0) (-filter -PosFixnum 0)))
-     (-> -Zero -Int B : (-FS (-filter -NonNegFixnum 1) (-filter -NegFixnum 1)))
-     (-> -PosInt -Int B : (-FS (-filter -PosFixnum 1) -top))
-     (-> -Int -Nat B : (-FS -top (-filter -PosFixnum 0)))
-     (-> -Nat -Int B : (-FS (-filter -NonNegFixnum 1) -top))
-     (-> -Int -NegInt B : (-FS (-filter -NegFixnum 0) -top))
-     (-> -Int -NonPosInt B : (-FS (-filter -NonPosFixnum 0) -top))
-     (-> -NonPosInt -Int B : (-FS -top (-filter -NegFixnum 1)))
-     (comp -Int)))
+    (lambda ()
+      (fx-from-cases
+       (-> -Pos -One B : (-FS (-filter -One 0) -top))
+       (-> -Byte -Zero B : (-FS (-filter -Zero 0) (-filter -PosByte 0)))
+       (-> -Zero -Byte B : (-FS -top (-filter (Un) 1)))
+       (-> -One -Byte B : (-FS (-filter -PosByte 1) (-filter -Zero 1)))
+       (-> -PosByte -Byte B : (-FS (-filter -PosByte 1) -top))
+       (-> -Byte -Byte B : (-FS -top (-filter -PosByte 0)))
+       (-> -Pos -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
+       (-> -Byte -Pos B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
+       (-> -Nat -Byte B : (-FS (-filter -Byte 0) -top))
+       (-> -Byte -Nat B : (-FS -top (-and (-filter -PosByte 0) (-filter -Byte 1))))
+       (-> -Index -Zero B : (-FS (-filter -Zero 0) (-filter -PosIndex 0)))
+       (-> -Zero -Index B : (-FS -top (-filter (Un) 1)))
+       (-> -One -Index B : (-FS (-filter -PosIndex 1) (-filter -Zero 1)))
+       (-> -PosIndex -Index B : (-FS (-filter -PosIndex 1) -top))
+       (-> -Index -Index B : (-FS -top (-filter -PosIndex 0)))
+       (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
+       (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
+       (-> -Nat -Index B : (-FS (-filter -Index 0) -top))
+       (-> -Index -Nat B : (-FS -top (-and (-filter -PosIndex 0) (-filter -Index 1))))
+       ;; general integer cases
+       (-> -Nat -Zero B : (-FS (-filter -Zero 0) -top))
+       (-> -One -Nat B : (-FS (-filter -PosFixnum 1) (-filter -Zero 1)))
+       (-> -Int -Zero B : (-FS (-filter -NonPosFixnum 0) (-filter -PosFixnum 0)))
+       (-> -Zero -Int B : (-FS (-filter -NonNegFixnum 1) (-filter -NegFixnum 1)))
+       (-> -PosInt -Int B : (-FS (-filter -PosFixnum 1) -top))
+       (-> -Int -Nat B : (-FS -top (-filter -PosFixnum 0)))
+       (-> -Nat -Int B : (-FS (-filter -NonNegFixnum 1) -top))
+       (-> -Int -NegInt B : (-FS (-filter -NegFixnum 0) -top))
+       (-> -Int -NonPosInt B : (-FS (-filter -NonPosFixnum 0) -top))
+       (-> -NonPosInt -Int B : (-FS -top (-filter -NegFixnum 1)))
+       (comp -Int))))
   (define fx>=-type
-    (fx-from-cases
-     (-> -One -Pos B : (-FS (-filter -One 1) -top))
-     (-> -Zero -Byte B : (-FS (-filter -Zero 1) (-filter -PosByte 1)))
-     (-> -Byte -Zero B : (-FS -top (-filter (Un) 0)))
-     (-> -Byte -One B : (-FS (-filter -PosByte 0) (-filter -Zero 0)))
-     (-> -Byte -PosByte B : (-FS (-filter -PosByte 0) -top))
-     (-> -Byte -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Byte -Pos B : (-FS (-and (-filter -PosByte 1) (-filter -PosByte 0)) -top))
-     (-> -Pos -Byte B : (-FS -top (-and (-filter -PosByte 1) (-filter -PosByte 0))))
-     (-> -Byte -Nat B : (-FS (-filter -Byte 1) -top))
-     (-> -Nat -Byte B : (-FS -top (-and (-filter -Byte 0) (-filter -PosByte 1))))
-     (-> -Zero -Index B : (-FS (-filter -Zero 1) (-filter -PosIndex 1)))
-     (-> -Index -Zero B : (-FS -top (-filter (Un) 0)))
-     (-> -Index -One B : (-FS (-filter -PosIndex 0) (-filter -Zero 0)))
-     (-> -Index -PosIndex B : (-FS (-filter -PosIndex 0) -top))
-     (-> -Index -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -Index -Nat B : (-FS (-filter -Index 1) -top))
-     (-> -Nat -Index B : (-FS -top (-and (-filter -Index 0) (-filter -PosIndex 1))))
-     ;; general integer cases
-     (-> -Zero -Nat B : (-FS (-filter -Zero 1) -top))
-     (-> -Nat -One B : (-FS (-filter -PosFixnum 0) (-filter -Zero 0)))
-     (-> -Zero -Int B : (-FS (-filter -NonPosFixnum 1) (-filter -PosFixnum 1)))
-     (-> -Int -Zero B : (-FS (-filter -NonNegFixnum 0) (-filter -NegFixnum 0)))
-     (-> -Int -PosInt B : (-FS (-filter -PosFixnum 0) -top))
-     (-> -Nat -Int B : (-FS -top (-filter -PosFixnum 1)))
-     (-> -Int -Nat B : (-FS (-filter -NonNegFixnum 0) -top))
-     (-> -NegInt -Int B : (-FS (-filter -NegFixnum 1) -top))
-     (-> -NonPosInt -Int B : (-FS (-filter -NonPosFixnum 1) -top))
-     (-> -Int -NonPosInt B : (-FS -top (-filter -NegFixnum 0)))
-     (comp -Int)))
+    (lambda ()
+      (fx-from-cases
+       (-> -One -Pos B : (-FS (-filter -One 1) -top))
+       (-> -Zero -Byte B : (-FS (-filter -Zero 1) (-filter -PosByte 1)))
+       (-> -Byte -Zero B : (-FS -top (-filter (Un) 0)))
+       (-> -Byte -One B : (-FS (-filter -PosByte 0) (-filter -Zero 0)))
+       (-> -Byte -PosByte B : (-FS (-filter -PosByte 0) -top))
+       (-> -Byte -Byte B : (-FS -top (-filter -PosByte 1)))
+       (-> -Byte -Pos B : (-FS (-and (-filter -PosByte 1) (-filter -PosByte 0)) -top))
+       (-> -Pos -Byte B : (-FS -top (-and (-filter -PosByte 1) (-filter -PosByte 0))))
+       (-> -Byte -Nat B : (-FS (-filter -Byte 1) -top))
+       (-> -Nat -Byte B : (-FS -top (-and (-filter -Byte 0) (-filter -PosByte 1))))
+       (-> -Zero -Index B : (-FS (-filter -Zero 1) (-filter -PosIndex 1)))
+       (-> -Index -Zero B : (-FS -top (-filter (Un) 0)))
+       (-> -Index -One B : (-FS (-filter -PosIndex 0) (-filter -Zero 0)))
+       (-> -Index -PosIndex B : (-FS (-filter -PosIndex 0) -top))
+       (-> -Index -Index B : (-FS -top (-filter -PosIndex 1)))
+       (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
+       (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
+       (-> -Index -Nat B : (-FS (-filter -Index 1) -top))
+       (-> -Nat -Index B : (-FS -top (-and (-filter -Index 0) (-filter -PosIndex 1))))
+       ;; general integer cases
+       (-> -Zero -Nat B : (-FS (-filter -Zero 1) -top))
+       (-> -Nat -One B : (-FS (-filter -PosFixnum 0) (-filter -Zero 0)))
+       (-> -Zero -Int B : (-FS (-filter -NonPosFixnum 1) (-filter -PosFixnum 1)))
+       (-> -Int -Zero B : (-FS (-filter -NonNegFixnum 0) (-filter -NegFixnum 0)))
+       (-> -Int -PosInt B : (-FS (-filter -PosFixnum 0) -top))
+       (-> -Nat -Int B : (-FS -top (-filter -PosFixnum 1)))
+       (-> -Int -Nat B : (-FS (-filter -NonNegFixnum 0) -top))
+       (-> -NegInt -Int B : (-FS (-filter -NegFixnum 1) -top))
+       (-> -NonPosInt -Int B : (-FS (-filter -NonPosFixnum 1) -top))
+       (-> -Int -NonPosInt B : (-FS -top (-filter -NegFixnum 0)))
+       (comp -Int))))
   (define fxmin-type
-    (fx-from-cases
-     (binop -Zero)
-     (binop -One)
-     (commutative-binop -Zero (Un -Zero -One) -Zero)
-     (commutative-binop -PosByte -PosInt -PosByte)
-     (commutative-binop -Byte -Nat -Byte)
-     (commutative-binop -PosIndex -PosInt -PosIndex)
-     (commutative-binop -Index -Nat -Index)
-     (-> -Pos -Pos -PosFixnum)
-     (-> -Nat -Nat -NonNegFixnum)
-     (commutative-binop -NegInt -Int -NegFixnum)
-     (commutative-binop -NonPosInt -Int -NonPosInt)
-     (-> -Int -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (binop -Zero)
+       (binop -One)
+       (commutative-binop -Zero (Un -Zero -One) -Zero)
+       (commutative-binop -PosByte -PosInt -PosByte)
+       (commutative-binop -Byte -Nat -Byte)
+       (commutative-binop -PosIndex -PosInt -PosIndex)
+       (commutative-binop -Index -Nat -Index)
+       (-> -Pos -Pos -PosFixnum)
+       (-> -Nat -Nat -NonNegFixnum)
+       (commutative-binop -NegInt -Int -NegFixnum)
+       (commutative-binop -NonPosInt -Int -NonPosInt)
+       (-> -Int -Int -Fixnum))))
   (define fxmax-type
-    (fx-from-cases
-     (binop -Zero)
-     (commutative-binop -One (Un -Zero -One) -One)
-     (commutative-binop -PosByte -Byte -PosByte)
-     (binop -Byte)
-     (commutative-binop -PosIndex -Index -PosIndex)
-     (map binop (list -Index -NegFixnum -NonPosFixnum))
-     (commutative-binop -PosInt -Int -PosFixnum)
-     (commutative-binop -Nat -Int -NonNegFixnum)
-     (-> -Int -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (binop -Zero)
+       (commutative-binop -One (Un -Zero -One) -One)
+       (commutative-binop -PosByte -Byte -PosByte)
+       (binop -Byte)
+       (commutative-binop -PosIndex -Index -PosIndex)
+       (map binop (list -Index -NegFixnum -NonPosFixnum))
+       (commutative-binop -PosInt -Int -PosFixnum)
+       (commutative-binop -Nat -Int -NonNegFixnum)
+       (-> -Int -Int -Fixnum))))
   (define fxand-type
-    (fx-from-cases
-     (commutative-binop -Zero -Int -Zero)
-     (commutative-binop -Byte -Int -Byte)
-     (commutative-binop -Index -Int -Index)
-     (binop -Nat -NonNegFixnum)
-     (binop -NegInt -NegFixnum)
-     (binop -NonPosInt -NonPosFixnum)
-     (binop -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (commutative-binop -Zero -Int -Zero)
+       (commutative-binop -Byte -Int -Byte)
+       (commutative-binop -Index -Int -Index)
+       (binop -Nat -NonNegFixnum)
+       (binop -NegInt -NegFixnum)
+       (binop -NonPosInt -NonPosFixnum)
+       (binop -Int -Fixnum))))
   (define fxior-type
-    (fx-from-cases
-     (binop -Zero)
-     (commutative-binop -One -Zero -One)
-     (commutative-binop -PosByte -Byte -PosByte)
-     (binop -Byte)
-     (commutative-binop -PosIndex -Index -PosIndex)
-     (binop -Index)
-     (commutative-binop -PosInt -Nat -PosFixnum)
-     (binop -Nat -NonNegFixnum)
-     (commutative-binop -NegInt -Int -NegFixnum) ; as long as there's one negative, the result is negative
-     (binop -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (binop -Zero)
+       (commutative-binop -One -Zero -One)
+       (commutative-binop -PosByte -Byte -PosByte)
+       (binop -Byte)
+       (commutative-binop -PosIndex -Index -PosIndex)
+       (binop -Index)
+       (commutative-binop -PosInt -Nat -PosFixnum)
+       (binop -Nat -NonNegFixnum)
+       (commutative-binop -NegInt -Int -NegFixnum) ; as long as there's one negative, the result is negative
+       (binop -Int -Fixnum))))
   (define fxxor-type
-    (fx-from-cases
-     (binop -Zero)
-     (binop -One -Zero)
-     (binop -Byte)
-     (binop -Index)
-     (binop -Nat -NonNegFixnum)
-     (binop -NonPosInt -NonNegFixnum)
-     (commutative-binop -NegInt -Nat -NegFixnum)
-     (commutative-binop -NonPosInt -Nat -NonPosFixnum)
-     (binop -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (binop -Zero)
+       (binop -One -Zero)
+       (binop -Byte)
+       (binop -Index)
+       (binop -Nat -NonNegFixnum)
+       (binop -NonPosInt -NonNegFixnum)
+       (commutative-binop -NegInt -Nat -NegFixnum)
+       (commutative-binop -NonPosInt -Nat -NonPosFixnum)
+       (binop -Int -Fixnum))))
   (define fxnot-type
-    (fx-from-cases
-     (-Nat . -> . -NegFixnum)
-     (-NegInt . -> . -NonNegFixnum)
-     (-Int . -> . -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (-Nat . -> . -NegFixnum)
+       (-NegInt . -> . -NonNegFixnum)
+       (-Int . -> . -Fixnum))))
   (define fxlshift-type
-    (fx-from-cases
-     (map (lambda (x) (-> x -Zero x))
-          (list -Zero -One -PosByte -Byte -PosIndex -Index))
-     (-> -PosInt -Int -PosFixnum) ; negative 2nd arg errors, so we can't reach 0
-     (-> -Nat -Int -NonNegFixnum)
-     (-> -NegInt -Int -NegFixnum)
-     (-> -NonPosInt -Int -NonPosFixnum)
-     (binop -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (map (lambda (x) (-> x -Zero x))
+            (list -Zero -One -PosByte -Byte -PosIndex -Index))
+       (-> -PosInt -Int -PosFixnum) ; negative 2nd arg errors, so we can't reach 0
+       (-> -Nat -Int -NonNegFixnum)
+       (-> -NegInt -Int -NegFixnum)
+       (-> -NonPosInt -Int -NonPosFixnum)
+       (binop -Int -Fixnum))))
   (define fxrshift-type
-    (fx-from-cases
-     (map (lambda (x) (-> x -Zero x))
-          (list -Zero -One -PosByte -Byte -PosIndex -Index))
-     (-> -Nat -Int -NonNegFixnum) ; can reach 0
-     (-> -NegInt -Int -NegFixnum) ; can't reach 0
-     (-> -NonPosInt -Int -NonPosFixnum)
-     (binop -Int -Fixnum)))
+    (lambda ()
+      (fx-from-cases
+       (map (lambda (x) (-> x -Zero x))
+            (list -Zero -One -PosByte -Byte -PosIndex -Index))
+       (-> -Nat -Int -NonNegFixnum) ; can reach 0
+       (-> -NegInt -Int -NegFixnum) ; can't reach 0
+       (-> -NonPosInt -Int -NonPosFixnum)
+       (binop -Int -Fixnum))))
 
 
-  (define flabs-type (cl->* (-> (Un -PosFlonum -NegFlonum) -PosFlonum)
-                            (-> -Flonum -NonNegFlonum)))
+  (define flabs-type
+    (lambda ()
+      (cl->* (-> (Un -PosFlonum -NegFlonum) -PosFlonum)
+             (-> -Flonum -NonNegFlonum))))
   (define fl+-type
-    (from-cases (map (lambda (t) (commutative-binop t -FlonumZero t))
-                     all-flonum-types)
-                (commutative-binop -NonNegFlonum -PosFlonum -PosFlonum)
-                (map binop (list -NonNegFlonum -NegFlonum -NonPosFlonum -Flonum))
-                (-Flonum -Flonum . -> . -Flonum)))
+    (lambda ()
+      (from-cases (map (lambda (t) (commutative-binop t -FlonumZero t))
+                       all-flonum-types)
+                  (commutative-binop -NonNegFlonum -PosFlonum -PosFlonum)
+                  (map binop (list -NonNegFlonum -NegFlonum -NonPosFlonum -Flonum))
+                  (-Flonum -Flonum . -> . -Flonum))))
   (define fl--type
-    (from-cases (binop -FlonumZero)
-                (-NegFlonum (Un -NonNegFlonum -FlonumZero) . -> . -NegFlonum)
-                ((Un -NonPosFlonum -FlonumZero) -PosFlonum . -> . -NegFlonum)
-                (-NonPosFlonum -NonNegFlonum . -> . -NonPosFlonum)
-                (binop -Flonum)))
+    (lambda ()
+      (from-cases (binop -FlonumZero)
+                  (-NegFlonum (Un -NonNegFlonum -FlonumZero) . -> . -NegFlonum)
+                  ((Un -NonPosFlonum -FlonumZero) -PosFlonum . -> . -NegFlonum)
+                  (-NonPosFlonum -NonNegFlonum . -> . -NonPosFlonum)
+                  (binop -Flonum))))
   (define fl*-type
-    (from-cases (map binop (list -FlonumPosZero -FlonumNegZero))
-                (commutative-binop -FlonumNegZero -FlonumPosZero -FlonumNegZero)
-                (binop -FlonumNegZero -FlonumPosZero)
-                ;; we don't have Pos Pos -> Pos, possible underflow
-                (map binop (list -FlonumZero -NonNegFlonum))
-                (commutative-binop -NegFlonum -PosFlonum -NonPosFlonum)
-                (binop -NegFlonum -NonNegFlonum)
-                (commutative-binop -NonPosFlonum -NonNegFlonum -NonPosFlonum)
-                (binop -NonPosFlonum -NonNegFlonum)
-                (binop -Flonum)))
+    (lambda ()
+      (from-cases (map binop (list -FlonumPosZero -FlonumNegZero))
+                  (commutative-binop -FlonumNegZero -FlonumPosZero -FlonumNegZero)
+                  (binop -FlonumNegZero -FlonumPosZero)
+                  ;; we don't have Pos Pos -> Pos, possible underflow
+                  (map binop (list -FlonumZero -NonNegFlonum))
+                  (commutative-binop -NegFlonum -PosFlonum -NonPosFlonum)
+                  (binop -NegFlonum -NonNegFlonum)
+                  (commutative-binop -NonPosFlonum -NonNegFlonum -NonPosFlonum)
+                  (binop -NonPosFlonum -NonNegFlonum)
+                  (binop -Flonum))))
   (define fl/-type
-    (from-cases (-FlonumPosZero -PosFlonum . -> . -FlonumPosZero)
-                (-FlonumPosZero -NegFlonum . -> . -FlonumNegZero)
-                (-FlonumNegZero -PosFlonum . -> . -FlonumNegZero)
-                (-FlonumNegZero -NegFlonum . -> . -FlonumPosZero)
-                (-PosFlonum -PosFlonum . -> . -NonNegFlonum) ; possible underflow
-                (commutative-binop -PosFlonum -NegFlonum -NonPosFlonum)
-                (-NegFlonum -NegFlonum . -> . -NonNegFlonum)
-                (binop -Flonum)))
+    (lambda ()
+      (from-cases (-FlonumPosZero -PosFlonum . -> . -FlonumPosZero)
+                  (-FlonumPosZero -NegFlonum . -> . -FlonumNegZero)
+                  (-FlonumNegZero -PosFlonum . -> . -FlonumNegZero)
+                  (-FlonumNegZero -NegFlonum . -> . -FlonumPosZero)
+                  (-PosFlonum -PosFlonum . -> . -NonNegFlonum) ; possible underflow
+                  (commutative-binop -PosFlonum -NegFlonum -NonPosFlonum)
+                  (-NegFlonum -NegFlonum . -> . -NonNegFlonum)
+                  (binop -Flonum))))
   (define fl=-type
-    (from-cases (map (lambda (l) (exclude-zero (car l) (cadr l) -FlonumZero))
-                     (list (list -NonNegFlonum -PosFlonum)
-                           (list -NonPosFlonum -NegFlonum)))
-                (map (lambda (t) (commutative-equality/filter -Flonum t))
-                     (list -FlonumZero -PosFlonum -NonNegFlonum
-                           -NegFlonum -NonPosFlonum))
-                (comp -Flonum)))
+    (lambda ()
+      (from-cases (map (lambda (l) (exclude-zero (car l) (cadr l) -FlonumZero))
+                       (list (list -NonNegFlonum -PosFlonum)
+                             (list -NonPosFlonum -NegFlonum)))
+                  (map (lambda (t) (commutative-equality/filter -Flonum t))
+                       (list -FlonumZero -PosFlonum -NonNegFlonum
+                             -NegFlonum -NonPosFlonum))
+                  (comp -Flonum))))
   (define fl<-type
-    (from-cases
-     (-> -FlonumZero -Flonum B : (-FS (-filter -PosFlonum 1) (-filter (Un -NonPosFlonum -FlonumPosZero) 1)))
-     (-> -Flonum -FlonumZero B : (-FS (-filter -NegFlonum 0) (-filter (Un -NonNegFlonum -FlonumNegZero) 0)))
-     (-> -PosFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
-     (-> -Flonum -PosFlonum B : (-FS -top (-filter -PosFlonum 0)))
-     (-> -NonNegFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
-     (-> -Flonum -NonNegFlonum B : (-FS -top (-filter (Un -NonNegFlonum -FlonumNegZero) 0)))
-     (-> -NegFlonum -Flonum B : (-FS -top (-filter -NegFlonum 1)))
-     (-> -Flonum -NegFlonum B : (-FS (-filter -NegFlonum 0) -top))
-     (-> -NonPosFlonum -Flonum B : (-FS -top (-filter (Un -NonPosFlonum -FlonumPosZero) 1)))
-     (-> -Flonum -NonPosFlonum B : (-FS (-filter -NegFlonum 0) -top))
-     (comp -Flonum)))
+    (lambda ()
+      (from-cases
+       (-> -FlonumZero -Flonum B : (-FS (-filter -PosFlonum 1) (-filter (Un -NonPosFlonum -FlonumPosZero) 1)))
+       (-> -Flonum -FlonumZero B : (-FS (-filter -NegFlonum 0) (-filter (Un -NonNegFlonum -FlonumNegZero) 0)))
+       (-> -PosFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
+       (-> -Flonum -PosFlonum B : (-FS -top (-filter -PosFlonum 0)))
+       (-> -NonNegFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
+       (-> -Flonum -NonNegFlonum B : (-FS -top (-filter (Un -NonNegFlonum -FlonumNegZero) 0)))
+       (-> -NegFlonum -Flonum B : (-FS -top (-filter -NegFlonum 1)))
+       (-> -Flonum -NegFlonum B : (-FS (-filter -NegFlonum 0) -top))
+       (-> -NonPosFlonum -Flonum B : (-FS -top (-filter (Un -NonPosFlonum -FlonumPosZero) 1)))
+       (-> -Flonum -NonPosFlonum B : (-FS (-filter -NegFlonum 0) -top))
+       (comp -Flonum))))
   (define fl>-type
-    (from-cases
-     (-> -FlonumZero -Flonum B : (-FS (-filter -NegFlonum 1) (-filter (Un -NonNegFlonum -FlonumNegZero) 1)))
-     (-> -Flonum -FlonumZero B : (-FS (-filter -PosFlonum 0) (-filter (Un -NonPosFlonum -FlonumPosZero) 0)))
-     (-> -PosFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
-     (-> -Flonum -PosFlonum B : (-FS (-filter -PosFlonum 0) -top))
-     (-> -NonNegFlonum -Flonum B : (-FS -top (-filter (Un -NonNegFlonum -FlonumNegZero) 1)))
-     (-> -Flonum -NonNegFlonum B : (-FS (-filter -PosFlonum 0) -top))
-     (-> -NegFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
-     (-> -Flonum -NegFlonum B : (-FS -top (-filter -NegFlonum 0)))
-     (-> -NonPosFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
-     (-> -Flonum -NonPosFlonum B : (-FS -top (-filter (Un -NonPosFlonum -FlonumPosZero) 0)))
-     (comp -Flonum)))
+    (lambda ()
+      (from-cases
+       (-> -FlonumZero -Flonum B : (-FS (-filter -NegFlonum 1) (-filter (Un -NonNegFlonum -FlonumNegZero) 1)))
+       (-> -Flonum -FlonumZero B : (-FS (-filter -PosFlonum 0) (-filter (Un -NonPosFlonum -FlonumPosZero) 0)))
+       (-> -PosFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
+       (-> -Flonum -PosFlonum B : (-FS (-filter -PosFlonum 0) -top))
+       (-> -NonNegFlonum -Flonum B : (-FS -top (-filter (Un -NonNegFlonum -FlonumNegZero) 1)))
+       (-> -Flonum -NonNegFlonum B : (-FS (-filter -PosFlonum 0) -top))
+       (-> -NegFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
+       (-> -Flonum -NegFlonum B : (-FS -top (-filter -NegFlonum 0)))
+       (-> -NonPosFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
+       (-> -Flonum -NonPosFlonum B : (-FS -top (-filter (Un -NonPosFlonum -FlonumPosZero) 0)))
+       (comp -Flonum))))
   (define fl<=-type
-    (from-cases
-     (-> -FlonumZero -Flonum B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 1) (-filter -NegFlonum 1)))
-     (-> -Flonum -FlonumZero B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 0) (-filter -PosFlonum 0)))
-     (-> -PosFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
-     (-> -Flonum -PosFlonum B : (-FS -top (-filter -PosFlonum 0)))
-     (-> -NonNegFlonum -Flonum B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 1) -top))
-     (-> -Flonum -NonNegFlonum B : (-FS -top (-filter -PosFlonum 0)))
-     (-> -NegFlonum -Flonum B : (-FS -top (-filter -NegFlonum 1)))
-     (-> -Flonum -NegFlonum B : (-FS (-filter -NegFlonum 0) -top))
-     (-> -NonPosFlonum -Flonum B : (-FS -top (-filter -NegFlonum 1)))
-     (-> -Flonum -NonPosFlonum B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 0) -top))
-     (comp -Flonum)))
+    (lambda ()
+      (from-cases
+       (-> -FlonumZero -Flonum B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 1) (-filter -NegFlonum 1)))
+       (-> -Flonum -FlonumZero B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 0) (-filter -PosFlonum 0)))
+       (-> -PosFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
+       (-> -Flonum -PosFlonum B : (-FS -top (-filter -PosFlonum 0)))
+       (-> -NonNegFlonum -Flonum B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 1) -top))
+       (-> -Flonum -NonNegFlonum B : (-FS -top (-filter -PosFlonum 0)))
+       (-> -NegFlonum -Flonum B : (-FS -top (-filter -NegFlonum 1)))
+       (-> -Flonum -NegFlonum B : (-FS (-filter -NegFlonum 0) -top))
+       (-> -NonPosFlonum -Flonum B : (-FS -top (-filter -NegFlonum 1)))
+       (-> -Flonum -NonPosFlonum B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 0) -top))
+       (comp -Flonum))))
   (define fl>=-type
-    (from-cases
-     (-> -FlonumZero -Flonum B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 1) (-filter -PosFlonum 1)))
-     (-> -Flonum -FlonumZero B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 0) (-filter -NegFlonum 0)))
-     (-> -PosFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
-     (-> -Flonum -PosFlonum B : (-FS (-filter -PosFlonum 0) -top))
-     (-> -NonNegFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
-     (-> -Flonum -NonNegFlonum B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 0) -top))
-     (-> -NegFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
-     (-> -Flonum -NegFlonum B : (-FS -top (-filter -NegFlonum 0)))
-     (-> -NonPosFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
-     (-> -Flonum -NonPosFlonum B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 0) -top))
-     (comp -Flonum)))
+    (lambda ()
+      (from-cases
+       (-> -FlonumZero -Flonum B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 1) (-filter -PosFlonum 1)))
+       (-> -Flonum -FlonumZero B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 0) (-filter -NegFlonum 0)))
+       (-> -PosFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
+       (-> -Flonum -PosFlonum B : (-FS (-filter -PosFlonum 0) -top))
+       (-> -NonNegFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
+       (-> -Flonum -NonNegFlonum B : (-FS (-filter (Un -NonNegFlonum -FlonumNegZero) 0) -top))
+       (-> -NegFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
+       (-> -Flonum -NegFlonum B : (-FS -top (-filter -NegFlonum 0)))
+       (-> -NonPosFlonum -Flonum B : (-FS -top (-filter -PosFlonum 1)))
+       (-> -Flonum -NonPosFlonum B : (-FS (-filter (Un -NonPosFlonum -FlonumPosZero) 0) -top))
+       (comp -Flonum))))
   (define flmin-type
-    (from-cases (map binop
-                     (list -PosFlonum -NonNegFlonum -NegFlonum -NonPosFlonum -Flonum))))
+    (lambda ()
+      (from-cases (map binop
+                       (list -PosFlonum -NonNegFlonum -NegFlonum -NonPosFlonum -Flonum)))))
   (define flmax-type
-    (from-cases (commutative-case -PosFlonum -Flonum -PosFlonum)
-                (commutative-case -NonNegFlonum -Flonum -NonNegFlonum)
-                (binop -NegFlonum)
-                (commutative-case -NegFlonum -NonPosFlonum -NonPosFlonum)
-                (binop -Flonum)))
+    (lambda ()
+      (from-cases (commutative-case -PosFlonum -Flonum -PosFlonum)
+                  (commutative-case -NonNegFlonum -Flonum -NonNegFlonum)
+                  (binop -NegFlonum)
+                  (commutative-case -NegFlonum -NonPosFlonum -NonPosFlonum)
+                  (binop -Flonum))))
   (define flround-type ; truncate too
-    (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
-                                -NonNegFlonum -NonPosFlonum -Flonum))))
+    (lambda ()
+      (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
+                                  -NonNegFlonum -NonPosFlonum -Flonum)))))
   (define flfloor-type
-    (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
-                                -NonNegFlonum -NegFlonum -NonPosFlonum -Flonum))))
+    (lambda ()
+      (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
+                                  -NonNegFlonum -NegFlonum -NonPosFlonum -Flonum)))))
   (define flceiling-type
-    (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
-                                -PosFlonum -NonNegFlonum -NonPosFlonum -Flonum))))
+    (lambda ()
+      (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
+                                  -PosFlonum -NonNegFlonum -NonPosFlonum -Flonum)))))
   (define fllog-type
-    (from-cases (-> -FlonumZero -NegFlonum) ; -inf
-                (-> -PosFlonum -NonNegFlonum) ; possible underflow
-                (unop -Flonum)))
+    (lambda ()
+      (from-cases (-> -FlonumZero -NegFlonum) ; -inf
+                  (-> -PosFlonum -NonNegFlonum) ; possible underflow
+                  (unop -Flonum))))
   (define flexp-type
-    (from-cases ((Un -NonNegFlonum -FlonumNegZero) . -> . -PosFlonum)
-                (-NegFlonum . -> . -NonNegFlonum)
-                (-Flonum . -> . -Flonum))) ; nan is the only non nonnegative case (returns nan)
+    (lambda ()
+      (from-cases ((Un -NonNegFlonum -FlonumNegZero) . -> . -PosFlonum)
+                  (-NegFlonum . -> . -NonNegFlonum)
+                  (-Flonum . -> . -Flonum)))) ; nan is the only non nonnegative case (returns nan)
   (define flsqrt-type
-    (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
-                                -NonNegFlonum ; we don't have positive case, possible underflow
-                                -Flonum)))) ; anything negative returns nan
-  (define fx->fl-type (fx-from-cases
-                       (-PosInt . -> . -PosFlonum)
-                       (-Nat . -> . -NonNegFlonum)
-                       (-NegInt . -> . -NegFlonum)
-                       (-NonPosInt . -> . -NonPosFlonum)
-                       (-Int . -> . -Flonum)))
-  (define make-flrectangular-type (-Flonum -Flonum . -> . -FloatComplex))
-  (define flreal-part-type (-FloatComplex . -> . -Flonum))
-  (define flimag-part-type (-FloatComplex . -> . -Flonum))
+    (lambda ()
+      (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
+                                  -NonNegFlonum ; we don't have positive case, possible underflow
+                                  -Flonum))))) ; anything negative returns nan
+  (define fx->fl-type
+    (lambda ()
+      (fx-from-cases
+       (-PosInt . -> . -PosFlonum)
+       (-Nat . -> . -NonNegFlonum)
+       (-NegInt . -> . -NegFlonum)
+       (-NonPosInt . -> . -NonPosFlonum)
+       (-Int . -> . -Flonum))))
+  (define make-flrectangular-type (lambda () (-Flonum -Flonum . -> . -FloatComplex)))
+  (define flreal-part-type (lambda () (-FloatComplex . -> . -Flonum)))
+  (define flimag-part-type (lambda () (-FloatComplex . -> . -Flonum)))
 
   ;; There's a repetitive pattern in the types of each comparison operator.
   ;; As explained below, this is because filters don't do intersections.
@@ -1461,8 +1503,8 @@
                   -InexactRealPosZero -InexactRealNegZero -InexactRealZero
                   -PosInexactReal -NonNegInexactReal -NonPosInexactReal -InexactReal
                   -RealZero -PosReal -NonNegReal -NonPosReal -Real)))]
-[truncate round-type]
-[round round-type]
+[truncate (round-type)]
+[round (round-type)]
 
 [make-rectangular (cl->* (-Rat -Rat . -> . -ExactNumber)
                          (-Flonum -Real . -> . -FloatComplex)
@@ -1747,117 +1789,117 @@
 
 
 ;; scheme/fixnum
-[fx+ fx+-type]
-[fx- fx--type]
-[fx* fx*-type]
-[fxquotient fxquotient-type]
-[fxremainder fxremainder-type]
-[fxmodulo fxmodulo-type]
-[fxabs fxabs-type]
+[fx+ (fx+-type)]
+[fx- (fx--type)]
+[fx* (fx*-type)]
+[fxquotient (fxquotient-type)]
+[fxremainder (fxremainder-type)]
+[fxmodulo (fxmodulo-type)]
+[fxabs (fxabs-type)]
 
-[fxand fxand-type]
-[fxior fxior-type]
-[fxxor fxxor-type]
-[fxnot fxnot-type]
-[fxlshift fxlshift-type]
-[fxrshift fxrshift-type]
+[fxand (fxand-type)]
+[fxior (fxior-type)]
+[fxxor (fxxor-type)]
+[fxnot (fxnot-type)]
+[fxlshift (fxlshift-type)]
+[fxrshift (fxrshift-type)]
 
-[fx= fx=-type]
-[fx< fx<-type]
-[fx> fx>-type]
-[fx<= fx<=-type]
-[fx>= fx>=-type]
-[fxmin fxmin-type]
-[fxmax fxmax-type]
+[fx= (fx=-type)]
+[fx< (fx<-type)]
+[fx> (fx>-type)]
+[fx<= (fx<=-type)]
+[fx>= (fx>=-type)]
+[fxmin (fxmin-type)]
+[fxmax (fxmax-type)]
 
-[unsafe-fx+ fx+-type]
-[unsafe-fx- fx--type]
-[unsafe-fx* fx*-type]
-[unsafe-fxquotient fxquotient-type]
-[unsafe-fxremainder fxremainder-type]
-[unsafe-fxmodulo fxmodulo-type]
-[unsafe-fxabs fxabs-type]
+[unsafe-fx+ (fx+-type)]
+[unsafe-fx- (fx--type)]
+[unsafe-fx* (fx*-type)]
+[unsafe-fxquotient (fxquotient-type)]
+[unsafe-fxremainder (fxremainder-type)]
+[unsafe-fxmodulo (fxmodulo-type)]
+[unsafe-fxabs (fxabs-type)]
 
-[unsafe-fxand fxand-type]
-[unsafe-fxior fxior-type]
-[unsafe-fxxor fxxor-type]
-[unsafe-fxnot fxnot-type]
-[unsafe-fxlshift fxlshift-type]
-[unsafe-fxrshift fxrshift-type]
+[unsafe-fxand (fxand-type)]
+[unsafe-fxior (fxior-type)]
+[unsafe-fxxor (fxxor-type)]
+[unsafe-fxnot (fxnot-type)]
+[unsafe-fxlshift (fxlshift-type)]
+[unsafe-fxrshift (fxrshift-type)]
 
-[unsafe-fx= fx=-type]
-[unsafe-fx< fx<-type]
-[unsafe-fx> fx>-type]
-[unsafe-fx<= fx<=-type]
-[unsafe-fx>= fx>=-type]
-[unsafe-fxmin fxmin-type]
-[unsafe-fxmax fxmax-type]
+[unsafe-fx= (fx=-type)]
+[unsafe-fx< (fx<-type)]
+[unsafe-fx> (fx>-type)]
+[unsafe-fx<= (fx<=-type)]
+[unsafe-fx>= (fx>=-type)]
+[unsafe-fxmin (fxmin-type)]
+[unsafe-fxmax (fxmax-type)]
 
 
 ;; flonum ops
-[flabs flabs-type]
-[fl+ fl+-type]
-[fl- fl--type]
-[fl* fl*-type]
-[fl/ fl/-type]
-[fl= fl=-type]
-[fl<= fl<=-type]
-[fl>= fl>=-type]
-[fl> fl>-type]
-[fl< fl<-type]
-[flmin flmin-type]
-[flmax flmax-type]
-[flround flround-type]
-[flfloor flfloor-type]
-[flceiling flceiling-type]
-[fltruncate flround-type]
-[flsin fl-unop] ; special cases (0s) not worth special-casing
-[flcos fl-unop]
-[fltan fl-unop]
-[flatan fl-unop]
-[flasin fl-unop]
-[flacos fl-unop]
-[fllog fllog-type]
-[flexp flexp-type]
-[flsqrt flsqrt-type]
-[->fl fx->fl-type]
-[make-flrectangular make-flrectangular-type]
-[flreal-part flreal-part-type]
-[flimag-part flimag-part-type]
+[flabs (flabs-type)]
+[fl+ (fl+-type)]
+[fl- (fl--type)]
+[fl* (fl*-type)]
+[fl/ (fl/-type)]
+[fl= (fl=-type)]
+[fl<= (fl<=-type)]
+[fl>= (fl>=-type)]
+[fl> (fl>-type)]
+[fl< (fl<-type)]
+[flmin (flmin-type)]
+[flmax (flmax-type)]
+[flround (flround-type)]
+[flfloor (flfloor-type)]
+[flceiling (flceiling-type)]
+[fltruncate (flround-type)]
+[flsin (fl-unop)] ; special cases (0s) not worth special-casing
+[flcos (fl-unop)]
+[fltan (fl-unop)]
+[flatan (fl-unop)]
+[flasin (fl-unop)]
+[flacos (fl-unop)]
+[fllog (fllog-type)]
+[flexp (flexp-type)]
+[flsqrt (flsqrt-type)]
+[->fl (fx->fl-type)]
+[make-flrectangular (make-flrectangular-type)]
+[flreal-part (flreal-part-type)]
+[flimag-part (flimag-part-type)]
 
-[unsafe-flabs flabs-type]
-[unsafe-fl+ fl+-type]
-[unsafe-fl- fl--type]
-[unsafe-fl* fl*-type]
-[unsafe-fl/ fl/-type]
-[unsafe-fl= fl=-type]
-[unsafe-fl<= fl<=-type]
-[unsafe-fl>= fl>=-type]
-[unsafe-fl> fl>-type]
-[unsafe-fl< fl<-type]
-[unsafe-flmin flmin-type]
-[unsafe-flmax flmax-type]
+[unsafe-flabs (flabs-type)]
+[unsafe-fl+ (fl+-type)]
+[unsafe-fl- (fl--type)]
+[unsafe-fl* (fl*-type)]
+[unsafe-fl/ (fl/-type)]
+[unsafe-fl= (fl=-type)]
+[unsafe-fl<= (fl<=-type)]
+[unsafe-fl>= (fl>=-type)]
+[unsafe-fl> (fl>-type)]
+[unsafe-fl< (fl<-type)]
+[unsafe-flmin (flmin-type)]
+[unsafe-flmax (flmax-type)]
 
 ;These are currently the same binding as the safe versions
 ;and so are not needed. If this changes they should be
 ;uncommented. There is a check in the definitions part of
 ;the file that makes sure that they are the same binding.
 ;
-;[unsafe-flround flround-type]
-;[unsafe-flfloor flfloor-type]
-;[unsafe-flceiling flceiling-type]
-;[unsafe-fltruncate flround-type]
-;[unsafe-flsin fl-unop]
-;[unsafe-flcos fl-unop]
-;[unsafe-fltan fl-unop]
-;[unsafe-flatan fl-unop]
-;[unsafe-flasin fl-unop]
-;[unsafe-flacos fl-unop]
-;[unsafe-fllog fllog-type]
-;[unsafe-flexp flexp-type]
+;[unsafe-flround (flround-type)]
+;[unsafe-flfloor (flfloor-type)]
+;[unsafe-flceiling (flceiling-type)]
+;[unsafe-fltruncate (flround-type)]
+;[unsafe-flsin (fl-unop)]
+;[unsafe-flcos (fl-unop)]
+;[unsafe-fltan (fl-unop)]
+;[unsafe-flatan (fl-unop)]
+;[unsafe-flasin (fl-unop)]
+;[unsafe-flacos (fl-unop)]
+;[unsafe-fllog (fllog-type)]
+;[unsafe-flexp (flexp-type)]
 ;
-[unsafe-flsqrt flsqrt-type]
-[unsafe-fx->fl fx->fl-type]
-[unsafe-make-flrectangular make-flrectangular-type]
-[unsafe-flreal-part flreal-part-type]
-[unsafe-flimag-part flimag-part-type]
+[unsafe-flsqrt (flsqrt-type)]
+[unsafe-fx->fl (fx->fl-type)]
+[unsafe-make-flrectangular (make-flrectangular-type)]
+[unsafe-flreal-part (flreal-part-type)]
+[unsafe-flimag-part (flimag-part-type)]
diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-racket/base-env/base-env.rkt
similarity index 96%
rename from collects/typed-scheme/base-env/base-env.rkt
rename to collects/typed-racket/base-env/base-env.rkt
index 5b1d921730..d80eae8855 100644
--- a/collects/typed-scheme/base-env/base-env.rkt
+++ b/collects/typed-racket/base-env/base-env.rkt
@@ -738,43 +738,6 @@
 
 ;Section 14.2.5
 ;racket/file
-#|
-[file->string (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String)]
-[file->bytes (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Bytes)]
-[file->value (->key -Pathlike #:mode (one-of/c 'binary 'text) #f Univ)]
-[file->list
- (-poly (a)
-  (cl->* (->key -Pathlike #:mode (one-of/c 'binary 'text) #f (-lst Univ))
-         (->key -Pathlike (-> -Input-Port a) #:mode (one-of/c 'binary 'text) #f (-lst a))))]
-
-[file->lines
- (->key -Pathlike #:mode (one-of/c 'binary 'text) #f
-        #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f
-        (-lst -String))]
-[file->bytes-lines
- (->key -Pathlike #:mode (one-of/c 'binary 'text) #f
-        #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f
-        (-lst -Bytes))]
-
-[display-to-file
- (->key Univ -Pathlike
-        #:mode (one-of/c 'binary 'text) #f
-        #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f
-        -Void)]
-[write-to-file
- (->key Univ -Pathlike
-        #:mode (one-of/c 'binary 'text) #f
-        #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f
-        -Void)]
-
-[display-lines-to-file
- (->key (-lst Univ) -Pathlike
-        #:separator Univ #f
-        #:mode (one-of/c 'binary 'text) #f
-        #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f
-        -Void)]
-|#
-
 [copy-directory/files (-> -Pathlike -Pathlike -Void)]
 [delete-directory/files (-> -Pathlike -Void)]
 
@@ -789,59 +752,12 @@
      ((Un funarg funarg*) a [(-opt -Pathlike) Univ]. ->opt . a)))]
 
 [make-directory* (-> -Pathlike -Void)]
-[make-temporary-file (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)]
+#;[make-temporary-file (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)]
 
-#|
-[get-preference
- (let ((use-lock-type Univ)
-       (timeout-lock-there-type (-opt (-> -Path Univ)))
-       (lock-there-type (-opt (-> -Path Univ))))
-  (cl->*
-   (->key Sym
-          #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f
-          Univ)
-   (->key Sym (-> Univ)
-          #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f
-          Univ)
-   (->key Sym (-> Univ) Univ
-          #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f
-          Univ)
-   (->key Sym (-> Univ) Univ (-opt -Pathlike)
-          #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f
-          Univ)))]
-|#
 
 [put-preferences (->opt (-lst -Symbol) (-lst Univ) [(-> -Path Univ) (-opt -Pathlike)] -Void)]
 [preferences-lock-file-mode (-> (one-of/c 'exists 'file-lock))]
 
-#|
-[make-handle-get-preference-locked
- (let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real))
-  (cl->*
-   (->key -Real Sym
-          #:lock-there lock-there-type #f #:max-delay max-delay-type #f
-          (-> -Pathlike Univ))
-   (->key -Real Sym (-> Univ)
-          #:lock-there lock-there-type #f #:max-delay max-delay-type #f
-          (-> -Pathlike Univ))
-   (->key -Real Sym (-> Univ) Univ
-          #:lock-there lock-there-type #f #:max-delay max-delay-type #f
-          (-> -Pathlike Univ))
-   (->key -Real Sym (-> Univ) Univ (-opt -Pathlike)
-          #:lock-there lock-there-type #f #:max-delay max-delay-type #f
-          (-> -Pathlike Univ))))]
-
-[call-with-file-lock/timeout
- (-poly (a)
-  (->key (-opt -Pathlike)
-         (one-of/c 'shared 'exclusive)
-         (-> a)
-         (-> a)
-         #:lock-file (-opt -Pathlike) #f
-         #:delay -Real #f
-         #:max-delay -Real #f
-          a))]
-|#
 
 [make-lock-file-name (->opt -Pathlike [-Pathlike] -Pathlike)]
 
@@ -1377,7 +1293,7 @@
 [syntax-local-make-delta-introducer (-> (-Syntax Sym) (-> (-Syntax Sym) (-Syntax Sym)))]
 
 [syntax-local-transforming-module-provides? (-> B)]
-[syntax-local-module-defined-identifiers (-> (-values (list (-Syntax Sym) (-Syntax Sym))))]
+[syntax-local-module-defined-identifiers (-> (-HT (Un B -Int) (-lst (-Syntax Sym))))]
 [syntax-local-module-required-identifiers (-> (-opt -Module-Path) (Un B -Int) (-lst (-pair (-opt -Int) (-lst (-Syntax Sym)))))]
 
 ;Section 11.5
@@ -2557,3 +2473,6 @@
 [will-register (-poly (a) (-> -Will-Executor a (-> a ManyUniv) -Void))]
 [will-execute (-> -Will-Executor ManyUniv)]
 [will-try-execute (-> -Will-Executor ManyUniv)]
+
+;; reader graphs
+[make-reader-graph (-> Univ Univ)]
\ No newline at end of file
diff --git a/collects/typed-scheme/base-env/base-special-env.rkt b/collects/typed-racket/base-env/base-special-env.rkt
similarity index 81%
rename from collects/typed-scheme/base-env/base-special-env.rkt
rename to collects/typed-racket/base-env/base-special-env.rkt
index 37eb392313..9b3e034fea 100644
--- a/collects/typed-scheme/base-env/base-special-env.rkt
+++ b/collects/typed-racket/base-env/base-special-env.rkt
@@ -7,48 +7,52 @@
  string-constants/string-constant
  racket/private/kw racket/file racket/port syntax/parse racket/path
  (for-template (only-in racket/private/kw kw-expander-proc kw-expander-impl)
-               racket/base racket/promise racket/file racket/port racket/path string-constants/string-constant)
+               racket/base racket/file racket/port racket/path)
  (utils tc-utils)
  (env init-envs)
  (except-in (rep filter-rep object-rep type-rep) make-arr)
  (types convenience union)
  (only-in (types convenience) [make-arr* make-arr])
- (for-template )
  (for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval)))
 
 (define-syntax (define-initial-env stx)
   (syntax-parse stx
-    [(_ initialize-env [id-expr ty] ...)
+    [(_ initialize-env [id-expr ty] ... #:middle [id-expr* ty*] ...)
      #`(begin
-         (define initial-env (make-env [id-expr ty] ...))
-         (define (initialize-env) (initialize-type-env initial-env))
+         (define initial-env (make-env [id-expr (λ () ty)] ... ))
+         (do-time "finished special types")
+         (define initial-env* (make-env [id-expr* (λ () ty*)] ...))
+         (define (initialize-env) (initialize-type-env initial-env) (initialize-type-env initial-env*))
          (provide initialize-env))]))
 
+(define (make-template-identifier what where)
+  (let ([name (module-path-index-resolve (module-path-index-join where #f))])
+    (parameterize ([current-namespace (make-empty-namespace)])
+      (namespace-attach-module (current-namespace) ''#%kernel)
+      (parameterize ([current-module-declare-name name])
+        (eval `(,#'module any '#%kernel
+                 (#%provide ,what)
+                 (define-values (,what) #f))))
+      (namespace-require `(for-template ,name))
+      (namespace-syntax-introduce (datum->syntax #f what)))))
+
+
 (define-initial-env initialize-special
   ;; make-promise
-  [(syntax-parse (local-expand #'(delay 3) 'expression null)
-     #:context #'make-promise
-     [(_ mp . _) #'mp])
+  [(make-template-identifier 'delay 'racket/private/promise)
    (-poly (a) (-> (-> a) (-Promise a)))]
-  
+
   ;; language
-  [(syntax-parse (local-expand #'(this-language) 'expression null)
-     #:context #'language
-     [lang #'lang])
+  [(make-template-identifier 'language 'string-constants/string-constant)
    -Symbol]
   ;; qq-append
-  [(syntax-parse (local-expand #'`(,@'() 1) 'expression null)
-     #:context #'qq-append
-     [(_ qqa . _) #'qqa])
-   (-poly (a b)
-         (cl->*
-          (-> (-lst a) (-val '()) (-lst a))
-          (-> (-lst a) (-lst b) (-lst (*Un a b)))))]
+ [(make-template-identifier 'qq-append 'racket/private/qq-and-or)
+  (-poly (a b)
+        (cl->*
+         (-> (-lst a) (-val '()) (-lst a))
+         (-> (-lst a) (-lst b) (-lst (*Un a b)))))]
   ;; make-sequence
-  [(syntax-parse (local-expand #'(for ([x '()]) x) 'expression #f)
-     #:context #'make-sequence
-     #:literals (let-values quote)
-     [(let-values ([_ (m-s '(_) '())]) . _) #'m-s])
+  [(make-template-identifier 'make-sequence 'racket/private/for)
    (-poly (a b)
           (let ([seq-vals
                  (lambda (a)
@@ -63,9 +67,7 @@
              (-> Univ (-seq a) (seq-vals (list a)))
              (-> Univ (-seq a b) (seq-vals (list a b))))))]
   ;; in-range
-  [(syntax-parse (local-expand #'(in-range 1) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-range 'racket/private/for)
    (cl->* (-PosFixnum -Fixnum [-Nat] . ->opt . (-seq -PosFixnum))
           (-NonNegFixnum [-Fixnum -Nat] . ->opt . (-seq -NonNegFixnum))
           (-Fixnum [-Fixnum -Int] . ->opt . (-seq -Fixnum))
@@ -73,118 +75,66 @@
           (-Nat [-Int -Nat] . ->opt . (-seq -Nat))
           (-Int [-Int -Int] . ->opt . (-seq -Int)))]
   ;; in-naturals
-  [(syntax-parse (local-expand #'(in-naturals) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-naturals 'racket/private/for)
    (cl->* (-> -PosInt (-seq -PosInt))
           (-> -Int (-seq -Nat)))]
   ;; in-list
-  [(syntax-parse (local-expand #'(in-list '(1 2 3)) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-list 'racket/private/for)
    (-poly (a) (-> (-lst a) (-seq a)))]
   ;; in-vector
-  [(syntax-parse (local-expand #'(in-vector (vector 1 2 3)) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-vector 'racket/private/for)
    (-poly (a) (->opt (-vec a) [-Int (-opt -Int) -Int] (-seq a)))]
   ;; in-string
-  [(syntax-parse (local-expand #'(in-string "abc") 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-string 'racket/private/for)
    (->opt -String [-Int (-opt -Int) -Int] (-seq -Char))]
   ;; in-bytes
-  [(syntax-parse (local-expand #'(in-bytes #"abc") 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-bytes 'racket/private/for)
    (->opt -Bytes [-Int (-opt -Int) -Int] (-seq -Byte))]
   ;; in-hash and friends
-  [(syntax-parse (local-expand #'(in-hash #hash((1 . 2))) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-hash 'racket/private/for)
    (-poly (a b) (-> (-HT a b) (-seq a b)))]
-  [(syntax-parse (local-expand #'(in-hash-keys #hash((1 . 2))) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-hash-keys 'racket/private/for)
    (-poly (a b) (-> (-HT a b) (-seq a)))]
-  [(syntax-parse (local-expand #'(in-hash-values #hash((1 . 2))) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-hash-values 'racket/private/for)
    (-poly (a b) (-> (-HT a b) (-seq b)))]
   ;; in-port
-  [(syntax-parse (local-expand #'(in-port) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-port 'racket/private/for)
    (->opt [(-> -Input-Port Univ) -Input-Port] (-seq Univ))]
   ;; in-input-port-bytes
-  [(syntax-parse (local-expand #'(in-input-port-bytes (open-input-bytes #"abc")) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-input-port-bytes 'racket/private/for)
    (-> -Input-Port (-seq -Byte))]
   ;; in-input-port-chars
-  [(syntax-parse (local-expand #'(in-input-port-chars (open-input-string "abc")) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-input-port-chars 'racket/private/for)
    (-> -Input-Port (-seq -Char))]
   ;; in-lines
-  [(syntax-parse (local-expand #'(in-lines) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-lines 'racket/private/for)
    (->opt [-Input-Port -Symbol] (-seq -String))]
   ;; in-bytes-lines
-  [(syntax-parse (local-expand #'(in-bytes-lines) 'expression #f)
-     [(i-n _ ...)
-      #'i-n])
+  [(make-template-identifier 'in-bytes-lines 'racket/private/for)
    (->opt [-Input-Port -Symbol] (-seq -Bytes))]
   ;; check-in-bytes-lines
-  [(syntax-parse (local-expand #'(for ([i (in-bytes-lines 0)]) i)
-                               'expression #f)
-                 #:literals (let-values let)
-     [(let-values ((_ (let _ (c . _) . _))
-                   . _)
-        . _)
-      #'c])
+  [(make-template-identifier 'check-in-bytes-lines 'racket/private/for)
    (-> Univ Univ Univ)]
   ;; check-in-lines
-  [(syntax-parse (local-expand #'(for ([i (in-lines 0)]) i)
-                               'expression #f)
-                 #:literals (let-values #%app let)
-     [(let-values ((_ (let _ (c . _) . _))
-                   . _)
-        . _)
-      #'c])
+  [(make-template-identifier 'check-in-lines 'racket/private/for)
    (-> Univ Univ Univ)]
   ;; check-in-port
-  [(syntax-parse (local-expand #'(for ([i (in-port 0)]) i)
-                               'expression #f)
-                 #:literals (let-values #%app let)
-     [(let-values ((_ (let _ (c . _) . _))
-                   . _)
-        . _)
-      #'c])
+  [(make-template-identifier 'check-in-port 'racket/private/for)
    (-> Univ Univ Univ)]
   ;; from the expansion of `with-syntax'
-  [(syntax-parse (local-expand #'(with-syntax ([x 1]) #'(x)) 'expression null)
-     #:literals (let-values #%plain-app #%plain-lambda if letrec-syntaxes+values)
-     [(let-values _
-        (let-values _
-          (let-values _
-            (if _
-                (let-values _ (letrec-syntaxes+values _ _ (#%plain-app (#%plain-lambda _ (#%plain-app apply-pattern-substitute _ _ _)) _)))
-                _))))
-      #'apply-pattern-substitute])
+  [(make-template-identifier 'apply-pattern-substitute 'racket/private/stxcase)
    (->* (list (-Syntax Univ) Univ) Univ Any-Syntax)]
-
-  [(syntax-parse (local-expand #'(with-syntax ([x 1]) #'(x)) 'expression null)
-     #:literals (let-values #%plain-app #%plain-lambda if letrec-syntaxes+values)
-    [(let-values _ (let-values _
-                     (let-values _ (if _ _ (let-values _
-                                             (if _ (let-values _ (letrec-syntaxes+values _ _ (#%plain-app with-syntax-fail _))) _))))))
-      #'with-syntax-fail])
+  ;; same
+  [(make-template-identifier 'with-syntax-fail 'racket/private/with-stx)
    (-> (-Syntax Univ) (Un))]
 
+
+  [(make-template-identifier 'make-temporary-file/proc 'racket/file)
+   (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)]
+
   ;; below here: keyword-argument functions from the base environment
   ;; FIXME: abstraction to remove duplication here
+  #:middle
 
   [((kw-expander-proc (syntax-local-value #'file->string)))
    (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String)]
diff --git a/collects/typed-scheme/base-env/base-structs.rkt b/collects/typed-racket/base-env/base-structs.rkt
similarity index 98%
rename from collects/typed-scheme/base-env/base-structs.rkt
rename to collects/typed-racket/base-env/base-structs.rkt
index 9751c719fb..96139755f6 100644
--- a/collects/typed-scheme/base-env/base-structs.rkt
+++ b/collects/typed-racket/base-env/base-structs.rkt
@@ -98,5 +98,4 @@
 
       (define-hierarchy exn:fail:user (#:kernel-maker k:exn:fail:user) ())))
 
-  ;; cce: adding exn:break would require a generic type for continuations
   (void))
diff --git a/collects/typed-scheme/base-env/base-types-extra.rkt b/collects/typed-racket/base-env/base-types-extra.rkt
similarity index 73%
rename from collects/typed-scheme/base-env/base-types-extra.rkt
rename to collects/typed-racket/base-env/base-types-extra.rkt
index f3b412e351..f686e74bd6 100644
--- a/collects/typed-scheme/base-env/base-types-extra.rkt
+++ b/collects/typed-racket/base-env/base-types-extra.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require (for-syntax scheme/base))
+(require (for-syntax racket/base))
 
 (define-syntax (define-other-types stx)
   (syntax-case stx ()
@@ -12,15 +12,10 @@
 
 ;; special type names that are not bound to particular types
 (define-other-types
-  #;-> case-> U Rec All Opaque Vector
+  -> case-> U Rec All Opaque Vector
   Parameterof List List* Class Values Instance Refinement
   pred)
 
-(define-syntax ->
-  (lambda (stx)
-    (raise-syntax-error 'type-check "type name used out of context" stx))) 
-(provide ->)
-
 (provide (rename-out [All ∀]
                      [U Un]
 		     [-> →]
diff --git a/collects/typed-scheme/base-env/base-types.rkt b/collects/typed-racket/base-env/base-types.rkt
similarity index 100%
rename from collects/typed-scheme/base-env/base-types.rkt
rename to collects/typed-racket/base-env/base-types.rkt
diff --git a/collects/typed-scheme/base-env/colon.rkt b/collects/typed-racket/base-env/colon.rkt
similarity index 89%
rename from collects/typed-scheme/base-env/colon.rkt
rename to collects/typed-racket/base-env/colon.rkt
index cef4b4ebab..fb8bdaffa1 100644
--- a/collects/typed-scheme/base-env/colon.rkt
+++ b/collects/typed-racket/base-env/colon.rkt
@@ -2,9 +2,7 @@
 
 (require (for-syntax scheme/base syntax/parse "internal.rkt")
          "../typecheck/internal-forms.rkt"
-         (prefix-in t: "base-types-extra.rkt")
-         (for-template (prefix-in t: "base-types-extra.rkt"))
-         (for-syntax (prefix-in t: "base-types-extra.rkt")))
+         (prefix-in t: "base-types-extra.rkt"))
 
 (provide :)
 
diff --git a/collects/typed-scheme/base-env/env-lang.rkt b/collects/typed-racket/base-env/env-lang.rkt
similarity index 96%
rename from collects/typed-scheme/base-env/env-lang.rkt
rename to collects/typed-racket/base-env/env-lang.rkt
index 4ed8cda1a0..781ec29cdd 100644
--- a/collects/typed-scheme/base-env/env-lang.rkt
+++ b/collects/typed-racket/base-env/env-lang.rkt
@@ -23,7 +23,7 @@
 	  extra
 	  (define e
 	    (parameterize ([infer-param infer])
-	      (make-env [id ty] ...)))
+	      (make-env [id (λ () ty)] ...)))
 	  (define (init)
 	   (initialize-type-env e))
           (provide init)))]
diff --git a/collects/typed-scheme/base-env/extra-procs.rkt b/collects/typed-racket/base-env/extra-procs.rkt
similarity index 94%
rename from collects/typed-scheme/base-env/extra-procs.rkt
rename to collects/typed-racket/base-env/extra-procs.rkt
index 0938125243..c04ea1c362 100644
--- a/collects/typed-scheme/base-env/extra-procs.rkt
+++ b/collects/typed-racket/base-env/extra-procs.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 (provide assert defined?)
 
 (define-syntax assert
diff --git a/collects/typed-scheme/base-env/for-clauses.rkt b/collects/typed-racket/base-env/for-clauses.rkt
similarity index 100%
rename from collects/typed-scheme/base-env/for-clauses.rkt
rename to collects/typed-racket/base-env/for-clauses.rkt
diff --git a/collects/typed-scheme/base-env/internal.rkt b/collects/typed-racket/base-env/internal.rkt
similarity index 100%
rename from collects/typed-scheme/base-env/internal.rkt
rename to collects/typed-racket/base-env/internal.rkt
diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt
similarity index 95%
rename from collects/typed-scheme/base-env/prims.rkt
rename to collects/typed-racket/base-env/prims.rkt
index 57ad6f505b..ac057f211b 100644
--- a/collects/typed-scheme/base-env/prims.rkt
+++ b/collects/typed-racket/base-env/prims.rkt
@@ -31,35 +31,33 @@ This file defines two sorts of primitives. All of them are provided into any mod
 (require "../utils/require-contract.rkt"
          "colon.rkt"
          "../typecheck/internal-forms.rkt"
-         (rename-in racket/contract [-> c->] [case-> c:case->])
+         (rename-in racket/contract/base [-> c->] [case-> c:case->])
          "base-types.rkt"
          "base-types-extra.rkt"
          racket/flonum ; for for/flvector and for*/flvector
          mzlib/etc
          (for-syntax
-          racket/match
           syntax/parse
           racket/syntax
           racket/base
           racket/struct-info
           syntax/struct
-          "../rep/type-rep.rkt"
-          "../private/parse-type.rkt"
+          "../rep/type-rep.rkt"          
           "annotate-classes.rkt"
           "internal.rkt"
           "../utils/tc-utils.rkt"
-          "../env/type-name-env.rkt"
-          "../private/type-contract.rkt"
-          "for-clauses.rkt"
-          "../tc-setup.rkt"
-          "../typecheck/tc-toplevel.rkt"
-          "../typecheck/tc-app-helper.rkt"
-          "../types/utils.rkt")
+          "../env/type-name-env.rkt"          
+          "for-clauses.rkt")
          "../types/numeric-predicates.rkt")
 (provide index?) ; useful for assert, and racket doesn't have it
 
 (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t))
 
+;; dynamically loaded b/c they're only used at the top-level, so we save a lot
+;; of loading by not having them when we're in a module
+(define-for-syntax (parse-type stx) ((dynamic-require 'typed-racket/private/parse-type 'parse-type) stx))
+(define-for-syntax (type->contract stx) ((dynamic-require 'typed-racket/private/type-contract 'type->contract) stx))
+
 
 (define-syntaxes (require/typed-legacy require/typed)
  (let ()
@@ -173,36 +171,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
          #,(internal #'(require/typed-internal name (Any -> Boolean : ty))))]))
 
 (define-syntax (:type stx)
-  (syntax-parse stx
-    [(_ ty:expr)
-     #`(display #,(format "~a\n" (parse-type #'ty)))]))
-
-;; Prints the _entire_ type. May be quite large.
+  (error ":type is only valid at the top-level of an interaction"))
 (define-syntax (:print-type stx)
-  (syntax-parse stx
-    [(_ e:expr)
-     #`(display #,(format "~a\n"
-                          (tc-setup #'stx #'e 'top-level expanded tc-toplevel-form type
-                                    (match type
-                                      [(tc-result1: t f o) t]
-                                      [(tc-results: t) (cons 'Values t)]))))]))
-
-;; given a function and a desired return type, fill in the blanks
+  (error ":print-type is only valid at the top-level of an interaction"))
 (define-syntax (:query-result-type stx)
-  (syntax-parse stx
-    [(_ op:expr desired-type:expr)
-     (let ([expected (parse-type #'desired-type)])
-       (tc-setup #'stx #'op 'top-level expanded tc-toplevel-form type
-                 (match type
-                   [(tc-result1: (and t (Function: _)) f o)
-                    (let ([cleaned (cleanup-type t expected)])
-                      #`(display
-                         #,(match cleaned
-                             [(Function: '())
-                              "Desired return type not in the given function's range."]
-                             [(Function: arrs)
-                              (format "~a\n" cleaned)])))]
-                   [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]))
+  (error ":query-result-type is only valid at the top-level of an interaction"))
 
 (define-syntax (require/opaque-type stx)
   (define-syntax-class name-exists-kw
diff --git a/collects/typed-scheme/base-env/type-env-lang.rkt b/collects/typed-racket/base-env/type-env-lang.rkt
similarity index 81%
rename from collects/typed-scheme/base-env/type-env-lang.rkt
rename to collects/typed-racket/base-env/type-env-lang.rkt
index 074080c111..452738467e 100644
--- a/collects/typed-scheme/base-env/type-env-lang.rkt
+++ b/collects/typed-racket/base-env/type-env-lang.rkt
@@ -1,9 +1,8 @@
-#lang scheme/base
+#lang racket/base
 
-(require "../utils/utils.rkt")
-
-(require (for-syntax (env init-envs)
-                     scheme/base syntax/parse
+(require "../utils/utils.rkt"
+         (for-syntax (env init-envs)
+                     racket/base syntax/parse
                      (except-in (rep filter-rep type-rep) make-arr)
                      (rename-in (types union convenience) [make-arr* make-arr])))
 
@@ -24,8 +23,8 @@
 
 (provide #%module-begin
          require
-         (all-from-out scheme/base)
+         (all-from-out racket/base)
          (for-syntax
           (types-out convenience union)
           (rep-out type-rep)
-          (all-from-out scheme/base)))
+          (all-from-out racket/base)))
diff --git a/collects/typed-scheme/core.rkt b/collects/typed-racket/core.rkt
similarity index 73%
rename from collects/typed-scheme/core.rkt
rename to collects/typed-racket/core.rkt
index deab5b85fd..97ba666916 100644
--- a/collects/typed-scheme/core.rkt
+++ b/collects/typed-racket/core.rkt
@@ -1,18 +1,16 @@
 #lang racket/base
 
-(require (rename-in "utils/utils.rkt" [infer r:infer])
+(require (rename-in "utils/utils.rkt")
          (for-syntax racket/base)
          (for-template racket/base)
-         (private with-types type-contract)
+         (private with-types type-contract parse-type)
          (except-in syntax/parse id)
          racket/match racket/syntax unstable/match racket/list
          (types utils convenience)
-         (typecheck typechecker provide-handling tc-toplevel tc-app-helper)
-         (env type-name-env type-alias-env)
-         (r:infer infer)
+         (typecheck provide-handling tc-toplevel tc-app-helper)
          (rep type-rep)
-         (except-in (utils utils tc-utils arm) infer)
-         (only-in (r:infer infer-dummy) infer-param)
+         (for-template (only-in (base-env prims) :type :print-type :query-result-type))
+         (utils utils tc-utils arm)
          "tc-setup.rkt")
 
 (provide mb-core ti-core wt-core)
@@ -52,6 +50,29 @@
   (syntax-parse stx
     [(_ . ((~datum module) . rest))
      #'(module . rest)]
+    [(_ . ((~literal :type) ty:expr))
+     #`(display #,(format "~a\n" (parse-type #'ty)))]
+    ;; Prints the _entire_ type. May be quite large.
+    [(_ . ((~literal :print-type) e:expr))
+     #`(display #,(format "~a\n"
+                          (tc-setup #'stx #'e 'top-level expanded tc-toplevel-form type
+                                    (match type
+                                      [(tc-result1: t f o) t]
+                                      [(tc-results: t) (cons 'Values t)]))))]
+    ;; given a function and a desired return type, fill in the blanks
+    [(_ . ((~literal :query-result-type) op:expr desired-type:expr))
+     (let ([expected (parse-type #'desired-type)])
+       (tc-setup #'stx #'op 'top-level expanded tc-toplevel-form type
+                 (match type
+                   [(tc-result1: (and t (Function: _)) f o)
+                    (let ([cleaned (cleanup-type t expected)])
+                      #`(display
+                         #,(match cleaned
+                             [(Function: '())
+                              "Desired return type not in the given function's range."]
+                             [(Function: arrs)
+                              (format "~a\n" cleaned)])))]
+                   [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]
     [(_ . form)
      (tc-setup
       stx #'form 'top-level body2 tc-toplevel-form type
diff --git a/collects/typed-scheme/env/global-env.rkt b/collects/typed-racket/env/global-env.rkt
similarity index 71%
rename from collects/typed-scheme/env/global-env.rkt
rename to collects/typed-racket/env/global-env.rkt
index 28b1aa2d78..3bb2577604 100644
--- a/collects/typed-scheme/env/global-env.rkt
+++ b/collects/typed-racket/env/global-env.rkt
@@ -5,8 +5,9 @@
 
 (require "../utils/utils.rkt"
 	 syntax/id-table
+         (rep type-rep)
          (utils tc-utils)
-         (types utils))
+         (types utils comparison))
 
 (provide register-type register-type-if-undefined
          finish-register-type
@@ -31,18 +32,24 @@
 (define (register-type-if-undefined id type)
   (cond [(free-id-table-ref the-mapping id (lambda _ #f))
          => (lambda (e)
-              (tc-error/expr #:stx id "Duplicate type annotation for ~a" (syntax-e id))
+              (define t (if (box? e) (unbox e) e))
+              (unless (and (Type? t) (type-equal? t type))
+                (tc-error/expr #:stx id "Duplicate type annotation of ~a for ~a, previous was ~a" type (syntax-e id) t))
               (when (box? e)
-                (free-id-table-set! the-mapping id (unbox e))))]
+                (free-id-table-set! the-mapping id t)))]
         [else (register-type id type)]))
 
 ;; add a single type to the mapping
 ;; identifier type -> void
 (define (register-type/undefined id type)
   ;(printf "register-type/undef ~a\n" (syntax-e id))
-  (if (free-id-table-ref the-mapping id (lambda _ #f))
-      (void (tc-error/expr #:stx id "Duplicate type annotation for ~a" (syntax-e id)))
-      (free-id-table-set! the-mapping id (box type))))
+  (cond [(free-id-table-ref the-mapping id (lambda _ #f))
+         =>
+         (λ (t) ;; it's ok to annotate with the same type
+           (define t* (if (box? t) (unbox t) t))
+           (unless (and (Type? t*) (type-equal? type t*))
+             (void (tc-error/expr #:stx id "Duplicate type annotation of ~a for ~a, previous was ~a" type (syntax-e id) t*))))]
+        [else (free-id-table-set! the-mapping id (box type))]))
 
 ;; add a bunch of types to the mapping
 ;; listof[id] listof[type] -> void
@@ -52,9 +59,11 @@
 ;; given an identifier, return the type associated with it
 ;; if none found, calls lookup-fail
 ;; identifier -> type
-(define (lookup-type id [fail-handler (lambda () (lookup-type-fail id))])
-  (let ([v (free-id-table-ref the-mapping id fail-handler)])
-    (if (box? v) (unbox v) v)))
+(define (lookup-type id [fail-handler (λ () (lookup-type-fail id))])
+  (define v (free-id-table-ref the-mapping id fail-handler))
+  (cond [(box? v) (unbox v)] 
+        [(procedure? v) (define t (v)) (register-type id t) t]
+        [else v]))
 
 (define (maybe-finish-register-type id)
   (let ([v (free-id-table-ref the-mapping id)])
diff --git a/collects/typed-scheme/env/index-env.rkt b/collects/typed-racket/env/index-env.rkt
similarity index 100%
rename from collects/typed-scheme/env/index-env.rkt
rename to collects/typed-racket/env/index-env.rkt
diff --git a/collects/typed-scheme/env/init-envs.rkt b/collects/typed-racket/env/init-envs.rkt
similarity index 96%
rename from collects/typed-scheme/env/init-envs.rkt
rename to collects/typed-racket/env/init-envs.rkt
index ab2be0991d..0ccbb511ca 100644
--- a/collects/typed-scheme/env/init-envs.rkt
+++ b/collects/typed-racket/env/init-envs.rkt
@@ -1,16 +1,15 @@
-#lang scheme/base
+#lang racket/base
 (provide (all-defined-out))
 (require "../utils/utils.rkt"
          "global-env.rkt"
 	 "type-name-env.rkt"
 	 "type-alias-env.rkt"
-         unstable/struct racket/dict
          (rep type-rep object-rep filter-rep rep-utils)
 	 (for-template (rep type-rep object-rep filter-rep)
 		       (types union)
-		       mzlib/pconvert mzlib/shared scheme/base)
+		       racket/shared racket/base)
 	 (types union convenience)
-	 mzlib/pconvert racket/match mzlib/shared)
+	 mzlib/pconvert racket/match)
 
 (define (initialize-type-name-env initial-type-names)
   (for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names))
diff --git a/collects/typed-scheme/env/lexical-env.rkt b/collects/typed-racket/env/lexical-env.rkt
similarity index 100%
rename from collects/typed-scheme/env/lexical-env.rkt
rename to collects/typed-racket/env/lexical-env.rkt
diff --git a/collects/typed-scheme/env/tvar-env.rkt b/collects/typed-racket/env/tvar-env.rkt
similarity index 100%
rename from collects/typed-scheme/env/tvar-env.rkt
rename to collects/typed-racket/env/tvar-env.rkt
diff --git a/collects/typed-scheme/env/type-alias-env.rkt b/collects/typed-racket/env/type-alias-env.rkt
similarity index 100%
rename from collects/typed-scheme/env/type-alias-env.rkt
rename to collects/typed-racket/env/type-alias-env.rkt
diff --git a/collects/typed-scheme/env/type-env-structs.rkt b/collects/typed-racket/env/type-env-structs.rkt
similarity index 100%
rename from collects/typed-scheme/env/type-env-structs.rkt
rename to collects/typed-racket/env/type-env-structs.rkt
diff --git a/collects/typed-scheme/env/type-name-env.rkt b/collects/typed-racket/env/type-name-env.rkt
similarity index 100%
rename from collects/typed-scheme/env/type-name-env.rkt
rename to collects/typed-racket/env/type-name-env.rkt
diff --git a/collects/typed-scheme/infer/constraint-structs.rkt b/collects/typed-racket/infer/constraint-structs.rkt
similarity index 100%
rename from collects/typed-scheme/infer/constraint-structs.rkt
rename to collects/typed-racket/infer/constraint-structs.rkt
diff --git a/collects/typed-scheme/infer/constraints.rkt b/collects/typed-racket/infer/constraints.rkt
similarity index 100%
rename from collects/typed-scheme/infer/constraints.rkt
rename to collects/typed-racket/infer/constraints.rkt
diff --git a/collects/typed-scheme/infer/dmap.rkt b/collects/typed-racket/infer/dmap.rkt
similarity index 100%
rename from collects/typed-scheme/infer/dmap.rkt
rename to collects/typed-racket/infer/dmap.rkt
diff --git a/collects/typed-scheme/infer/infer-dummy.rkt b/collects/typed-racket/infer/infer-dummy.rkt
similarity index 100%
rename from collects/typed-scheme/infer/infer-dummy.rkt
rename to collects/typed-racket/infer/infer-dummy.rkt
diff --git a/collects/typed-scheme/infer/infer-unit.rkt b/collects/typed-racket/infer/infer-unit.rkt
similarity index 100%
rename from collects/typed-scheme/infer/infer-unit.rkt
rename to collects/typed-racket/infer/infer-unit.rkt
diff --git a/collects/typed-scheme/infer/infer.rkt b/collects/typed-racket/infer/infer.rkt
similarity index 63%
rename from collects/typed-scheme/infer/infer.rkt
rename to collects/typed-racket/infer/infer.rkt
index c9da680d06..ccf9f1ad58 100644
--- a/collects/typed-scheme/infer/infer.rkt
+++ b/collects/typed-racket/infer/infer.rkt
@@ -1,12 +1,11 @@
-#lang scheme/base
+#lang racket/base
 
 (require (except-in "../utils/utils.rkt" infer))
 (require "infer-unit.rkt" "constraints.rkt" "dmap.rkt" "signatures.rkt"
          "restrict.rkt" "promote-demote.rkt"
-         mzlib/trace
-         (only-in scheme/unit provide-signature-elements
-                  define-values/invoke-unit/infer link)
-         (utils unit-utils))
+         racket/trace
+         (only-in racket/unit provide-signature-elements
+                  define-values/invoke-unit/infer link))
 
 (provide-signature-elements restrict^ infer^)
 
diff --git a/collects/typed-scheme/infer/promote-demote.rkt b/collects/typed-racket/infer/promote-demote.rkt
similarity index 100%
rename from collects/typed-scheme/infer/promote-demote.rkt
rename to collects/typed-racket/infer/promote-demote.rkt
diff --git a/collects/typed-scheme/infer/restrict.rkt b/collects/typed-racket/infer/restrict.rkt
similarity index 100%
rename from collects/typed-scheme/infer/restrict.rkt
rename to collects/typed-racket/infer/restrict.rkt
diff --git a/collects/typed-scheme/infer/signatures.rkt b/collects/typed-racket/infer/signatures.rkt
similarity index 96%
rename from collects/typed-scheme/infer/signatures.rkt
rename to collects/typed-racket/infer/signatures.rkt
index daff06cebd..342cf045ce 100644
--- a/collects/typed-scheme/infer/signatures.rkt
+++ b/collects/typed-racket/infer/signatures.rkt
@@ -1,7 +1,6 @@
 #lang racket/base
 (require racket/unit racket/contract racket/require
-         "constraint-structs.rkt"
-         (path-up "utils/utils.rkt" "utils/unit-utils.rkt" "rep/type-rep.rkt"))
+         "constraint-structs.rkt" (path-up "utils/utils.rkt" "rep/type-rep.rkt"))
 (provide (all-defined-out))
 
 (define-signature dmap^
diff --git a/collects/typed-scheme/info.rkt b/collects/typed-racket/info.rkt
similarity index 100%
rename from collects/typed-scheme/info.rkt
rename to collects/typed-racket/info.rkt
diff --git a/collects/typed-scheme/language-info.rkt b/collects/typed-racket/language-info.rkt
similarity index 57%
rename from collects/typed-scheme/language-info.rkt
rename to collects/typed-racket/language-info.rkt
index 31b2a23952..56b7e99ad5 100644
--- a/collects/typed-scheme/language-info.rkt
+++ b/collects/typed-racket/language-info.rkt
@@ -1,18 +1,17 @@
-#lang scheme/base
-(require typed-scheme/typed-reader)
+#lang racket/base
+(require typed-racket/typed-reader)
 (provide get-info configure)
 
 (define ((get-info arg) key default)
   (case key
-    [(configure-runtime) `(#(typed-scheme/language-info configure ()))]
+    [(configure-runtime) `(#(typed-racket/language-info configure ()))]
     [else default]))
 
 ;; options currently always empty
 (define (configure options)
-  (namespace-require 'scheme/base)
+  (namespace-require 'racket/base)
   (eval '(begin
-           (require (for-syntax typed-scheme/utils/tc-utils scheme/base))
+           (require (for-syntax typed-racket/utils/tc-utils racket/base))
            (begin-for-syntax (set-box! typed-context? #t)))
         (current-namespace))
   (current-readtable (readtable)))
-
diff --git a/collects/typed-scheme/minimal.rkt b/collects/typed-racket/minimal.rkt
similarity index 88%
rename from collects/typed-scheme/minimal.rkt
rename to collects/typed-racket/minimal.rkt
index b3a9ef68bc..e5de966449 100644
--- a/collects/typed-scheme/minimal.rkt
+++ b/collects/typed-racket/minimal.rkt
@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
 
 (provide #%module-begin provide require rename-in rename-out prefix-in only-in all-from-out except-out except-in
          providing begin subtract-in)
 
-(require (for-syntax scheme/base) scheme/require)
+(require (for-syntax racket/base) racket/require)
 
-(define-for-syntax ts-mod 'typed-scheme/typed-scheme)
+(define-for-syntax ts-mod 'typed-racket/typed-racket)
 
 (define-syntax (providing stx)
   (syntax-case stx (libs from basics except)
diff --git a/collects/typed-racket/minimal/lang/reader.rkt b/collects/typed-racket/minimal/lang/reader.rkt
new file mode 100644
index 0000000000..0c5c481cbf
--- /dev/null
+++ b/collects/typed-racket/minimal/lang/reader.rkt
@@ -0,0 +1,13 @@
+#lang s-exp syntax/module-reader
+
+typed-racket/minimal
+
+#:language-info make-language-info
+#:info make-info
+
+(define (make-info key default use-default)
+  (case key
+    [else (use-default key default)]))
+
+(define make-language-info
+  `#(typed-racket/language-info get-info ()))
diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-racket/optimizer/apply.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/apply.rkt
rename to collects/typed-racket/optimizer/apply.rkt
diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-racket/optimizer/box.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/box.rkt
rename to collects/typed-racket/optimizer/box.rkt
diff --git a/collects/typed-scheme/optimizer/dead-code.rkt b/collects/typed-racket/optimizer/dead-code.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/dead-code.rkt
rename to collects/typed-racket/optimizer/dead-code.rkt
diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-racket/optimizer/fixnum.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/fixnum.rkt
rename to collects/typed-racket/optimizer/fixnum.rkt
diff --git a/collects/typed-scheme/optimizer/float-complex.rkt b/collects/typed-racket/optimizer/float-complex.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/float-complex.rkt
rename to collects/typed-racket/optimizer/float-complex.rkt
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-racket/optimizer/float.rkt
similarity index 97%
rename from collects/typed-scheme/optimizer/float.rkt
rename to collects/typed-racket/optimizer/float.rkt
index b6620a224e..66022808f3 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-racket/optimizer/float.rkt
@@ -79,7 +79,11 @@
 (define (log-float-real-missed-opt stx irritants)
   (log-missed-optimization
    "all args float-arg-expr, result not Float"
-   "This expression has a Real type. It would be better optimized if it had a Float type. To fix this, change the highlighted expression(s) to have Float type(s)."
+   (string-append
+    "This expression has a Real type. It would be better optimized if it had a Float type."
+    (if (null? irritants)
+        ""
+        "To fix this, change the highlighted expression(s) to have Float type(s)."))
    stx irritants))
 
 (define float-opt-msg "Float arithmetic specialization.")
diff --git a/collects/typed-scheme/optimizer/list.rkt b/collects/typed-racket/optimizer/list.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/list.rkt
rename to collects/typed-racket/optimizer/list.rkt
diff --git a/collects/typed-scheme/optimizer/logging.rkt b/collects/typed-racket/optimizer/logging.rkt
similarity index 99%
rename from collects/typed-scheme/optimizer/logging.rkt
rename to collects/typed-racket/optimizer/logging.rkt
index 06f26eb18b..e8e7b29a02 100644
--- a/collects/typed-scheme/optimizer/logging.rkt
+++ b/collects/typed-racket/optimizer/logging.rkt
@@ -214,7 +214,7 @@
   (define logger (current-logger))
   (add-missed-opts-to-log)
   (for ([x (sort-log)])
-    (log-message logger 'warning
+    (log-message logger 'debug
                  (format-log-entry x)
                  (cons optimization-log-key x))))
 
@@ -232,7 +232,7 @@
 ;; only intercepts TR log messages
 (define (with-intercepted-tr-logging interceptor thunk)
   (with-intercepted-logging
-   #:level 'warning
+   #:level 'debug
    (lambda (l) ;; look only for optimizer messages
      (when (log-message-from-tr-opt? l)
        (interceptor l)))
diff --git a/collects/typed-scheme/optimizer/number.rkt b/collects/typed-racket/optimizer/number.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/number.rkt
rename to collects/typed-racket/optimizer/number.rkt
diff --git a/collects/typed-scheme/optimizer/numeric-utils.rkt b/collects/typed-racket/optimizer/numeric-utils.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/numeric-utils.rkt
rename to collects/typed-racket/optimizer/numeric-utils.rkt
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-racket/optimizer/optimizer.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/optimizer.rkt
rename to collects/typed-racket/optimizer/optimizer.rkt
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-racket/optimizer/pair.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/pair.rkt
rename to collects/typed-racket/optimizer/pair.rkt
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-racket/optimizer/sequence.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/sequence.rkt
rename to collects/typed-racket/optimizer/sequence.rkt
diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-racket/optimizer/string.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/string.rkt
rename to collects/typed-racket/optimizer/string.rkt
diff --git a/collects/typed-scheme/optimizer/struct.rkt b/collects/typed-racket/optimizer/struct.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/struct.rkt
rename to collects/typed-racket/optimizer/struct.rkt
diff --git a/collects/typed-scheme/optimizer/tool/display.rkt b/collects/typed-racket/optimizer/tool/display.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/tool/display.rkt
rename to collects/typed-racket/optimizer/tool/display.rkt
diff --git a/collects/typed-scheme/optimizer/tool/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt
similarity index 98%
rename from collects/typed-scheme/optimizer/tool/report.rkt
rename to collects/typed-racket/optimizer/tool/report.rkt
index f27f7cf140..f735f2e2fb 100644
--- a/collects/typed-scheme/optimizer/tool/report.rkt
+++ b/collects/typed-racket/optimizer/tool/report.rkt
@@ -2,8 +2,8 @@
 
 (require racket/class racket/gui/base racket/match racket/port
          unstable/syntax unstable/port racket/sandbox
-         typed-scheme/optimizer/logging
-         (prefix-in tr: typed-scheme/typed-reader))
+         typed-racket/optimizer/logging
+         (prefix-in tr: typed-racket/typed-reader))
 
 (provide (struct-out report-entry)
          (struct-out sub-report-entry)
diff --git a/collects/typed-scheme/optimizer/tool/tool.rkt b/collects/typed-racket/optimizer/tool/tool.rkt
similarity index 97%
rename from collects/typed-scheme/optimizer/tool/tool.rkt
rename to collects/typed-racket/optimizer/tool/tool.rkt
index 39a5adbcc9..926aa31aac 100644
--- a/collects/typed-scheme/optimizer/tool/tool.rkt
+++ b/collects/typed-racket/optimizer/tool/tool.rkt
@@ -42,7 +42,7 @@
          (let ([color (if (= badness 0)
                           "lightgreen"
                           (vector-ref color-table badness))])
-           (send this highlight-range start end color)
+           (send this highlight-range start end color #f 'high)
            (send this set-clickback start end (popup-callback l))
            ;; record highlight to undo it later
            (list start end color))]))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-racket/optimizer/unboxed-let.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/unboxed-let.rkt
rename to collects/typed-racket/optimizer/unboxed-let.rkt
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-racket/optimizer/utils.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/utils.rkt
rename to collects/typed-racket/optimizer/utils.rkt
diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-racket/optimizer/vector.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/vector.rkt
rename to collects/typed-racket/optimizer/vector.rkt
diff --git a/collects/typed-racket/private/parse-classes.rkt b/collects/typed-racket/private/parse-classes.rkt
new file mode 100644
index 0000000000..6e6b6db15e
--- /dev/null
+++ b/collects/typed-racket/private/parse-classes.rkt
@@ -0,0 +1,26 @@
+#lang racket/base
+
+(require syntax/parse)
+(provide star ddd ddd/bound)
+
+(define-syntax-class star
+  #:description "*"
+  (pattern star:id
+           #:fail-unless (eq? '* (syntax-e #'star)) "missing *")
+  (pattern star:id
+           #:fail-unless (eq? '...* (syntax-e #'star)) "missing ...*"))
+
+(define-syntax-class ddd
+  #:description "..."
+  (pattern ddd:id
+           #:fail-unless (eq? '... (syntax-e #'ddd)) "missing ..."))
+
+(define-splicing-syntax-class ddd/bound
+  #:description "... followed by variable name"
+  #:attributes (bound)
+  (pattern i:id
+           #:attr s (symbol->string (syntax-e #'i))
+           #:fail-unless ((string-length (attribute s)) . > . 3) #f
+           #:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
+           #:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
+  (pattern (~seq _:ddd bound:id)))
diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-racket/private/parse-type.rkt
similarity index 95%
rename from collects/typed-scheme/private/parse-type.rkt
rename to collects/typed-racket/private/parse-type.rkt
index 1c07f6b81f..45046205df 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-racket/private/parse-type.rkt
@@ -8,6 +8,7 @@
          syntax/parse
          (env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env)
          racket/match
+         "parse-classes.rkt"
          (for-template scheme/base "../base-env/colon.rkt")
          ;; needed at this phase for tests
          (combine-in (prefix-in t: "../base-env/base-types-extra.rkt") "../base-env/colon.rkt")
@@ -30,28 +31,6 @@
     (p stx*)))
 
 
-(define-syntax-class star
-  #:description "*"
-  (pattern star:id
-           #:fail-unless (eq? '* (syntax-e #'star)) "missing *")
-  (pattern star:id
-           #:fail-unless (eq? '...* (syntax-e #'star)) "missing ...*"))
-
-(define-syntax-class ddd
-  #:description "..."
-  (pattern ddd:id
-           #:fail-unless (eq? '... (syntax-e #'ddd)) "missing ..."))
-
-(define-splicing-syntax-class ddd/bound
-  #:description "... followed by variable name"
-  #:attributes (bound)
-  (pattern i:id
-           #:attr s (symbol->string (syntax-e #'i))
-           #:fail-unless ((string-length (attribute s)) . > . 3) #f
-           #:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
-           #:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
-  (pattern (~seq _:ddd bound:id)))
-
 (define (parse-all-body s)
   (syntax-parse s
     [(ty)
diff --git a/collects/typed-scheme/private/type-annotation.rkt b/collects/typed-racket/private/type-annotation.rkt
similarity index 93%
rename from collects/typed-scheme/private/type-annotation.rkt
rename to collects/typed-racket/private/type-annotation.rkt
index 198d316513..4516cb7a21 100644
--- a/collects/typed-scheme/private/type-annotation.rkt
+++ b/collects/typed-racket/private/type-annotation.rkt
@@ -1,12 +1,12 @@
-#lang scheme/base
+#lang racket/base
 
 (require "../utils/utils.rkt"
 	 (rep type-rep)
 	 (utils tc-utils)
 	 (env global-env)
-         (except-in (types subtype union convenience resolve utils) -> ->*)
+         (except-in (types subtype union convenience resolve utils comparison) -> ->*)
          (private parse-type)
-         (only-in scheme/contract listof ->)
+         (contract-req)
          racket/match mzlib/trace)
 (provide type-annotation
          get-type
@@ -38,10 +38,12 @@
 (define (type-annotation stx #:infer [let-binding #f])
   (define (pt prop)
     (when (and (identifier? stx)
-               let-binding
-               (lookup-type stx (lambda () #f)))
-      (maybe-finish-register-type stx)
-      (tc-error/expr #:stx stx "Duplicate type annotation for ~a" (syntax-e stx)))
+               let-binding)
+      (define t1 (parse-type/id stx prop))
+      (define t2 (lookup-type stx (lambda () #f)))      
+      (when (and t2 (not (type-equal? t1 t2)))
+        (maybe-finish-register-type stx)
+        (tc-error/expr #:stx stx "Duplicate type annotation of ~a for ~a, previous was ~a" t1 (syntax-e stx) t2)))
     (if (syntax? prop)
         (parse-type prop)
         (parse-type/id stx prop)))
diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt
similarity index 100%
rename from collects/typed-scheme/private/type-contract.rkt
rename to collects/typed-racket/private/type-contract.rkt
diff --git a/collects/typed-scheme/private/typed-renaming.rkt b/collects/typed-racket/private/typed-renaming.rkt
similarity index 91%
rename from collects/typed-scheme/private/typed-renaming.rkt
rename to collects/typed-racket/private/typed-renaming.rkt
index 39f6bfaf72..9310827fd7 100644
--- a/collects/typed-scheme/private/typed-renaming.rkt
+++ b/collects/typed-racket/private/typed-renaming.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require (for-syntax scheme/base))
+(require (for-syntax racket/base))
 
 (provide make-typed-renaming get-alternate)
 
diff --git a/collects/typed-scheme/private/with-types.rkt b/collects/typed-racket/private/with-types.rkt
similarity index 100%
rename from collects/typed-scheme/private/with-types.rkt
rename to collects/typed-racket/private/with-types.rkt
diff --git a/collects/typed-scheme/rep/filter-rep.rkt b/collects/typed-racket/rep/filter-rep.rkt
similarity index 96%
rename from collects/typed-scheme/rep/filter-rep.rkt
rename to collects/typed-racket/rep/filter-rep.rkt
index f25334dd33..ecf00a6fa5 100644
--- a/collects/typed-scheme/rep/filter-rep.rkt
+++ b/collects/typed-racket/rep/filter-rep.rkt
@@ -1,7 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require racket/match scheme/contract)
-(require "rep-utils.rkt" "free-variance.rkt")
+(require "rep-utils.rkt" "free-variance.rkt" racket/contract/base)
 
 (define (Filter/c-predicate? e)
   (and (Filter? e) (not (NoFilter? e)) (not (FilterSet? e))))
diff --git a/collects/typed-scheme/rep/free-variance.rkt b/collects/typed-racket/rep/free-variance.rkt
similarity index 89%
rename from collects/typed-scheme/rep/free-variance.rkt
rename to collects/typed-racket/rep/free-variance.rkt
index 7f113da345..480bb38404 100644
--- a/collects/typed-scheme/rep/free-variance.rkt
+++ b/collects/typed-racket/rep/free-variance.rkt
@@ -1,8 +1,5 @@
-#lang scheme/base
-(require "../utils/utils.rkt"
-	 (for-syntax scheme/base)
-         (utils tc-utils) scheme/list
-         mzlib/etc scheme/contract)
+#lang racket/base
+(require "../utils/utils.rkt" (for-syntax racket/base) (contract-req)) 
 
 (provide Covariant Contravariant Invariant Constant Dotted
          combine-frees flip-variances without-below unless-in-table
@@ -52,10 +49,10 @@
 ;; frees -> frees
 (define (flip-variances vs)
   (for/hasheq ([(k v) (in-hash vs)])
-    (values k (evcase v
-                [Covariant Contravariant]
-                [Contravariant Covariant]
-                [v v]))))
+    (values k 
+            (cond [(eq? v Covariant) Contravariant]
+                  [(eq? v Contravariant) Covariant]
+                  [else v]))))
 
 (define (make-invariant vs)
   (for/hasheq ([(k v) (in-hash vs)])
diff --git a/collects/typed-scheme/rep/interning.rkt b/collects/typed-racket/rep/interning.rkt
similarity index 85%
rename from collects/typed-scheme/rep/interning.rkt
rename to collects/typed-racket/rep/interning.rkt
index 79b6fd80c9..79fafd25d6 100644
--- a/collects/typed-scheme/rep/interning.rkt
+++ b/collects/typed-racket/rep/interning.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require syntax/boundmap (for-syntax scheme/base syntax/parse))
+(require syntax/id-table racket/dict (for-syntax racket/base syntax/parse))
 
 (provide defintern hash-id)
 
@@ -34,12 +34,12 @@
 (define count! (make-count!))
 (define id-count! (make-count!))
 
-(define identifier-table (make-module-identifier-mapping))
+(define identifier-table (make-free-id-table))
 
 (define (hash-id id)
-  (module-identifier-mapping-get
+  (dict-ref
    identifier-table
    id
    (lambda () (let ([c (id-count!)])
-                (module-identifier-mapping-put! identifier-table id c)
+                (dict-set! identifier-table id c)
                 c))))
diff --git a/collects/typed-scheme/rep/object-rep.rkt b/collects/typed-racket/rep/object-rep.rkt
similarity index 90%
rename from collects/typed-scheme/rep/object-rep.rkt
rename to collects/typed-racket/rep/object-rep.rkt
index a48085fb43..7582635d39 100644
--- a/collects/typed-scheme/rep/object-rep.rkt
+++ b/collects/typed-racket/rep/object-rep.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require racket/match scheme/contract "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt")
+(require "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt" "../utils/utils.rkt" (contract-req))
 (provide object-equal?)
 
 (def-pathelem CarPE () [#:fold-rhs #:base])
diff --git a/collects/typed-scheme/rep/rep-utils.rkt b/collects/typed-racket/rep/rep-utils.rkt
similarity index 97%
rename from collects/typed-scheme/rep/rep-utils.rkt
rename to collects/typed-racket/rep/rep-utils.rkt
index 3a365f930f..70ab968df4 100644
--- a/collects/typed-scheme/rep/rep-utils.rkt
+++ b/collects/typed-racket/rep/rep-utils.rkt
@@ -1,26 +1,19 @@
-#lang scheme/base
-(require "../utils/utils.rkt")
-
-(require mzlib/struct mzlib/pconvert
+#lang racket/base
+(require "../utils/utils.rkt"
+         mzlib/pconvert
          racket/match
-         syntax/boundmap
          "free-variance.rkt"
          "interning.rkt"
-	 racket/syntax unstable/match unstable/struct
-         mzlib/etc
+         unstable/match unstable/struct         
          racket/stxparam
-         scheme/contract
          (for-syntax
-          scheme/list
-          (only-in racket/syntax generate-temporary)
           racket/match
           (except-in syntax/parse id identifier keyword)
-          scheme/base
+          racket/base
           syntax/struct
-          syntax/stx
-          scheme/contract
+          racket/contract
 	  racket/syntax
-          (rename-in (except-in (utils utils stxclass-util) bytes byte-regexp regexp byte-pregexp pregexp)
+          (rename-in (except-in (utils stxclass-util) bytes byte-regexp regexp byte-pregexp pregexp)
                      [id* id]
                      [keyword* keyword])))
 
@@ -158,7 +151,7 @@
        (with-syntax
          ;; makes as many underscores as default fields (+1 for key? if provided)
         ([(ign-pats ...) (let loop ([fs default-fields])
-                           (if (empty? fs)
+                           (if (null? fs)
                                (key->list key? #'_)
                                (cons #'_ (loop (cdr fs)))))]
          ;; has to be down here to refer to #'contract
@@ -242,7 +235,7 @@
                                         #,(body-f)))]))
 
     (define (no-duplicates? lst)
-      (cond [(empty? lst) #t]
+      (cond [(null? lst) #t]
             [(member (car lst) (cdr lst)) #f]
             [else (no-duplicates? (cdr lst))]))
 
diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-racket/rep/type-rep.rkt
similarity index 100%
rename from collects/typed-scheme/rep/type-rep.rkt
rename to collects/typed-racket/rep/type-rep.rkt
diff --git a/collects/typed-scheme/scribblings/guide/begin.scrbl b/collects/typed-racket/scribblings/guide/begin.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/guide/begin.scrbl
rename to collects/typed-racket/scribblings/guide/begin.scrbl
diff --git a/collects/typed-scheme/scribblings/guide/more.scrbl b/collects/typed-racket/scribblings/guide/more.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/guide/more.scrbl
rename to collects/typed-racket/scribblings/guide/more.scrbl
diff --git a/collects/typed-scheme/scribblings/guide/optimization.scrbl b/collects/typed-racket/scribblings/guide/optimization.scrbl
similarity index 98%
rename from collects/typed-scheme/scribblings/guide/optimization.scrbl
rename to collects/typed-racket/scribblings/guide/optimization.scrbl
index bcf017696b..5a49236347 100644
--- a/collects/typed-scheme/scribblings/guide/optimization.scrbl
+++ b/collects/typed-racket/scribblings/guide/optimization.scrbl
@@ -181,8 +181,8 @@ can as a starting point for performance debugging.
 Similar information (albeit without in-depth explanations or advice) is
 available from the command line. When compiling a Typed Racket program, setting
 the racket @seclink[#:doc '(lib "scribblings/reference/reference.scrbl")
-"logging"]{logging} facilities to the @racket['warning] level causes Typed
+"logging"]{logging} facilities to the @racket['debug] level causes Typed
 Racket to display performance debugging information. Setting the Racket logging
 level can be done on the command line with the @racket[-W] flag:
 
-@commandline{racket -W warning my-typed-program.rkt}
+@commandline{racket -W debug my-typed-program.rkt}
diff --git a/collects/typed-scheme/scribblings/guide/quick.scrbl b/collects/typed-racket/scribblings/guide/quick.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/guide/quick.scrbl
rename to collects/typed-racket/scribblings/guide/quick.scrbl
diff --git a/collects/typed-scheme/scribblings/guide/types.scrbl b/collects/typed-racket/scribblings/guide/types.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/guide/types.scrbl
rename to collects/typed-racket/scribblings/guide/types.scrbl
diff --git a/collects/typed-scheme/scribblings/guide/varargs.scrbl b/collects/typed-racket/scribblings/guide/varargs.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/guide/varargs.scrbl
rename to collects/typed-racket/scribblings/guide/varargs.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl b/collects/typed-racket/scribblings/reference/compatibility-languages.scrbl
similarity index 83%
rename from collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl
rename to collects/typed-racket/scribblings/reference/compatibility-languages.scrbl
index 7428ccce24..d8969825a1 100644
--- a/collects/typed-scheme/scribblings/reference/compatibility-languages.scrbl
+++ b/collects/typed-racket/scribblings/reference/compatibility-languages.scrbl
@@ -12,11 +12,11 @@ languages. The @racketmod[typed-scheme] language is equivalent to the
 
 @(declare-exporting typed/scheme/base typed/scheme typed-scheme
                     #:use-sources
-                    (typed-scheme/typed-scheme
-                     typed-scheme/base-env/prims
-                     typed-scheme/base-env/extra-procs
-                     typed-scheme/base-env/base-types
-                     typed-scheme/base-env/base-types-extra))
+                    (typed-racket/typed-racket
+                     typed-racket/base-env/prims
+                     typed-racket/base-env/extra-procs
+                     typed-racket/base-env/base-types
+                     typed-racket/base-env/base-types-extra))
 
 @(define-syntax-rule (def-racket rts rt)
   (begin
diff --git a/collects/typed-scheme/scribblings/reference/experimental.scrbl b/collects/typed-racket/scribblings/reference/experimental.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/experimental.scrbl
rename to collects/typed-racket/scribblings/reference/experimental.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/legacy.scrbl b/collects/typed-racket/scribblings/reference/legacy.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/legacy.scrbl
rename to collects/typed-racket/scribblings/reference/legacy.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/libraries.scrbl b/collects/typed-racket/scribblings/reference/libraries.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/libraries.scrbl
rename to collects/typed-racket/scribblings/reference/libraries.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/no-check.scrbl b/collects/typed-racket/scribblings/reference/no-check.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/no-check.scrbl
rename to collects/typed-racket/scribblings/reference/no-check.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/optimization.scrbl b/collects/typed-racket/scribblings/reference/optimization.scrbl
similarity index 91%
rename from collects/typed-scheme/scribblings/reference/optimization.scrbl
rename to collects/typed-racket/scribblings/reference/optimization.scrbl
index e4b459e8a0..7a3c0429ee 100644
--- a/collects/typed-scheme/scribblings/reference/optimization.scrbl
+++ b/collects/typed-racket/scribblings/reference/optimization.scrbl
@@ -7,7 +7,7 @@
 
 @note{
 See
-@secref[#:doc '(lib "typed-scheme/scribblings/ts-guide.scrbl")]{optimization}
+@secref[#:doc '(lib "typed-racket/scribblings/ts-guide.scrbl")]{optimization}
 in the guide for tips to get the most out of the optimizer.
 }
 
diff --git a/collects/typed-scheme/scribblings/reference/special-forms.scrbl b/collects/typed-racket/scribblings/reference/special-forms.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/special-forms.scrbl
rename to collects/typed-racket/scribblings/reference/special-forms.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/typed-regions.scrbl b/collects/typed-racket/scribblings/reference/typed-regions.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/typed-regions.scrbl
rename to collects/typed-racket/scribblings/reference/typed-regions.scrbl
diff --git a/collects/typed-scheme/scribblings/reference/types.scrbl b/collects/typed-racket/scribblings/reference/types.scrbl
similarity index 99%
rename from collects/typed-scheme/scribblings/reference/types.scrbl
rename to collects/typed-racket/scribblings/reference/types.scrbl
index 5dce9655f1..e04658d251 100644
--- a/collects/typed-scheme/scribblings/reference/types.scrbl
+++ b/collects/typed-racket/scribblings/reference/types.scrbl
@@ -68,6 +68,7 @@ Negative-Single-Flonum
 Nonnegative-Exact-Rational
 Nonnegative-Flonum
 Nonnegative-Inexact-Real
+Nonnegative-Integer
 Nonnegative-Real
 Nonnegative-Single-Flonum
 Nonpositive-Exact-Rational
diff --git a/collects/typed-scheme/scribblings/reference/utilities.scrbl b/collects/typed-racket/scribblings/reference/utilities.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/reference/utilities.scrbl
rename to collects/typed-racket/scribblings/reference/utilities.scrbl
diff --git a/collects/typed-scheme/scribblings/ts-guide.scrbl b/collects/typed-racket/scribblings/ts-guide.scrbl
similarity index 100%
rename from collects/typed-scheme/scribblings/ts-guide.scrbl
rename to collects/typed-racket/scribblings/ts-guide.scrbl
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-racket/scribblings/ts-reference.scrbl
similarity index 75%
rename from collects/typed-scheme/scribblings/ts-reference.scrbl
rename to collects/typed-racket/scribblings/ts-reference.scrbl
index 83ab1c843c..0f1f6ebc1b 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-racket/scribblings/ts-reference.scrbl
@@ -7,11 +7,11 @@
 
 @(defmodulelang* (typed/racket/base typed/racket)
                  #:use-sources
-                    (typed-scheme/typed-scheme
-                     typed-scheme/base-env/prims
-                     typed-scheme/base-env/extra-procs
-                     typed-scheme/base-env/base-types
-                     typed-scheme/base-env/base-types-extra))
+                    (typed-racket/typed-racket
+                     typed-racket/base-env/prims
+                     typed-racket/base-env/extra-procs
+                     typed-racket/base-env/base-types
+                     typed-racket/base-env/base-types-extra))
 
 @local-table-of-contents[]
 
diff --git a/collects/typed-scheme/scribblings/utils.rkt b/collects/typed-racket/scribblings/utils.rkt
similarity index 100%
rename from collects/typed-scheme/scribblings/utils.rkt
rename to collects/typed-racket/scribblings/utils.rkt
diff --git a/collects/typed-scheme/tc-setup.rkt b/collects/typed-racket/tc-setup.rkt
similarity index 91%
rename from collects/typed-scheme/tc-setup.rkt
rename to collects/typed-racket/tc-setup.rkt
index 1e051e8920..5d67fa2246 100644
--- a/collects/typed-scheme/tc-setup.rkt
+++ b/collects/typed-racket/tc-setup.rkt
@@ -4,7 +4,6 @@
          (except-in syntax/parse id)
          unstable/mutated-vars
          racket/pretty
-         (optimizer optimizer)
          (private type-contract)
          (types utils convenience)
          (typecheck typechecker provide-handling tc-toplevel)
@@ -27,8 +26,12 @@
 (define (maybe-optimize body)
   ;; do we optimize?
   (if (optimize?)
-      (begin0 (map optimize-top (syntax->list body))
-        (do-time "Optimized"))
+      (let ([optimize-top
+             (begin0 (dynamic-require 'typed-racket/optimizer/optimizer
+                                      'optimize-top)
+               (do-time "Loading optimizer"))])
+        (begin0 (map optimize-top (syntax->list body))
+          (do-time "Optimized")))
       body))
 
 (define-syntax-rule (tc-setup orig-stx stx expand-ctxt fully-expanded-stx checker result . body)
diff --git a/collects/typed-scheme/typecheck/check-below.rkt b/collects/typed-racket/typecheck/check-below.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/check-below.rkt
rename to collects/typed-racket/typecheck/check-below.rkt
diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.rkt b/collects/typed-racket/typecheck/check-subforms-unit.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/check-subforms-unit.rkt
rename to collects/typed-racket/typecheck/check-subforms-unit.rkt
diff --git a/collects/typed-scheme/typecheck/def-binding.rkt b/collects/typed-racket/typecheck/def-binding.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/def-binding.rkt
rename to collects/typed-racket/typecheck/def-binding.rkt
diff --git a/collects/typed-scheme/typecheck/def-export.rkt b/collects/typed-racket/typecheck/def-export.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/def-export.rkt
rename to collects/typed-racket/typecheck/def-export.rkt
diff --git a/collects/typed-scheme/typecheck/find-annotation.rkt b/collects/typed-racket/typecheck/find-annotation.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/find-annotation.rkt
rename to collects/typed-racket/typecheck/find-annotation.rkt
diff --git a/collects/typed-scheme/typecheck/internal-forms.rkt b/collects/typed-racket/typecheck/internal-forms.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/internal-forms.rkt
rename to collects/typed-racket/typecheck/internal-forms.rkt
diff --git a/collects/typed-scheme/typecheck/parse-cl.rkt b/collects/typed-racket/typecheck/parse-cl.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/parse-cl.rkt
rename to collects/typed-racket/typecheck/parse-cl.rkt
diff --git a/collects/typed-scheme/typecheck/provide-handling.rkt b/collects/typed-racket/typecheck/provide-handling.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/provide-handling.rkt
rename to collects/typed-racket/typecheck/provide-handling.rkt
diff --git a/collects/typed-scheme/typecheck/renamer.rkt b/collects/typed-racket/typecheck/renamer.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/renamer.rkt
rename to collects/typed-racket/typecheck/renamer.rkt
diff --git a/collects/typed-scheme/typecheck/signatures.rkt b/collects/typed-racket/typecheck/signatures.rkt
similarity index 92%
rename from collects/typed-scheme/typecheck/signatures.rkt
rename to collects/typed-racket/typecheck/signatures.rkt
index 5795e4c94f..a2d5bb6264 100644
--- a/collects/typed-scheme/typecheck/signatures.rkt
+++ b/collects/typed-racket/typecheck/signatures.rkt
@@ -1,9 +1,6 @@
-#lang scheme/base
-(require scheme/unit scheme/contract
-         "../utils/utils.rkt"
-         (rep type-rep)
-         (utils unit-utils)
-         (types utils))
+#lang racket/base
+(require racket/unit racket/contract
+         "../utils/utils.rkt" (rep type-rep) (types utils))
 (provide (all-defined-out))
 
 (define-signature tc-expr^
diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-racket/typecheck/tc-app-helper.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-app-helper.rkt
rename to collects/typed-racket/typecheck/tc-app-helper.rkt
diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-racket/typecheck/tc-app.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-app.rkt
rename to collects/typed-racket/typecheck/tc-app.rkt
diff --git a/collects/typed-scheme/typecheck/tc-apply.rkt b/collects/typed-racket/typecheck/tc-apply.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-apply.rkt
rename to collects/typed-racket/typecheck/tc-apply.rkt
diff --git a/collects/typed-scheme/typecheck/tc-envops.rkt b/collects/typed-racket/typecheck/tc-envops.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-envops.rkt
rename to collects/typed-racket/typecheck/tc-envops.rkt
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-racket/typecheck/tc-expr-unit.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-expr-unit.rkt
rename to collects/typed-racket/typecheck/tc-expr-unit.rkt
diff --git a/collects/typed-scheme/typecheck/tc-funapp.rkt b/collects/typed-racket/typecheck/tc-funapp.rkt
similarity index 98%
rename from collects/typed-scheme/typecheck/tc-funapp.rkt
rename to collects/typed-racket/typecheck/tc-funapp.rkt
index 940c5eff7a..723feabda9 100644
--- a/collects/typed-scheme/typecheck/tc-funapp.rkt
+++ b/collects/typed-racket/typecheck/tc-funapp.rkt
@@ -59,7 +59,7 @@
       (and argtys (list (tc-result1: argtys-t) ...)))
      (or
       ;; find the first function where the argument types match
-      (for/first ([dom doms] [rng rngs] [rest rests] [a arrs]
+      (for/first ([dom (in-list doms)] [rng (in-list rngs)] [rest (in-list rests)] [a (in-list arrs)]
                   #:when (subtypes/varargs argtys-t dom rest))
         ;; then typecheck here
         ;; we call the separate function so that we get the appropriate
diff --git a/collects/typed-scheme/typecheck/tc-if.rkt b/collects/typed-racket/typecheck/tc-if.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-if.rkt
rename to collects/typed-racket/typecheck/tc-if.rkt
diff --git a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt b/collects/typed-racket/typecheck/tc-lambda-unit.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-lambda-unit.rkt
rename to collects/typed-racket/typecheck/tc-lambda-unit.rkt
diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-racket/typecheck/tc-let-unit.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-let-unit.rkt
rename to collects/typed-racket/typecheck/tc-let-unit.rkt
diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.rkt b/collects/typed-racket/typecheck/tc-metafunctions.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-metafunctions.rkt
rename to collects/typed-racket/typecheck/tc-metafunctions.rkt
diff --git a/collects/typed-scheme/typecheck/tc-structs.rkt b/collects/typed-racket/typecheck/tc-structs.rkt
similarity index 97%
rename from collects/typed-scheme/typecheck/tc-structs.rkt
rename to collects/typed-racket/typecheck/tc-structs.rkt
index d93761c364..015c9af11e 100644
--- a/collects/typed-scheme/typecheck/tc-structs.rkt
+++ b/collects/typed-racket/typecheck/tc-structs.rkt
@@ -25,7 +25,7 @@
 (require (for-template scheme/base
                        "internal-forms.rkt"))
 
-(provide tc/struct tc/poly-struct names-of-struct tc/builtin-struct d-s)
+(provide tc/struct tc/poly-struct names-of-struct d-s)
 
 (define (names-of-struct stx)
   (define (parent? stx)
@@ -284,20 +284,17 @@
 ;; register a struct type
 ;; convenience function for built-in structs
 ;; tc/builtin-struct : identifier Maybe[identifier] Listof[identifier] Listof[Type] Maybe[identifier] Listof[Type] -> void
-(define/cond-contract (tc/builtin-struct nm parent flds tys kernel-maker #;parent-tys)
+;; FIXME - figure out how to make this lots lazier
+(define/cond-contract (tc/builtin-struct nm parent flds tys kernel-maker)
      (c-> identifier? (or/c #f identifier?) (listof identifier?)
-          (listof Type/c) (or/c #f identifier?) #;(listof fld?)
+          (listof Type/c) (or/c #f identifier?)
           any/c)
   (define parent-name (if parent (make-Name parent) #f))
   (define parent-flds (if parent (get-parent-flds parent-name) null))
   (define parent-tys (map fld-t parent-flds))
   (define defs (mk/register-sty nm flds parent-name parent-flds tys #:mutable #t))
-  (if kernel-maker
-      (let* ([result-type (lookup-type-name nm)]
-             [ty (->* (append parent-tys tys) result-type)])
-        (register-type kernel-maker ty)
-        (cons (make-def-binding kernel-maker ty) defs))
-      defs))
+  (when kernel-maker    
+    (register-type kernel-maker (λ () (->* (append parent-tys tys) (lookup-type-name nm))))))
 
 
 ;; syntax for tc/builtin-struct
diff --git a/collects/typed-scheme/typecheck/tc-subst.rkt b/collects/typed-racket/typecheck/tc-subst.rkt
similarity index 100%
rename from collects/typed-scheme/typecheck/tc-subst.rkt
rename to collects/typed-racket/typecheck/tc-subst.rkt
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-racket/typecheck/tc-toplevel.rkt
similarity index 78%
rename from collects/typed-scheme/typecheck/tc-toplevel.rkt
rename to collects/typed-racket/typecheck/tc-toplevel.rkt
index aa8da40b69..d388f711ad 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.rkt
+++ b/collects/typed-racket/typecheck/tc-toplevel.rkt
@@ -187,7 +187,7 @@
       [(#%require . _) (void)]
       [(#%provide . _) (void)]
       [(define-syntaxes . _) (void)]
-      [(define-values-for-syntax . _) (void)]
+      [(begin-for-syntax . _) (void)]
 
       ;; FIXME - we no longer need these special cases
       ;; these forms are handled in pass1
@@ -252,65 +252,70 @@
     [_ (int-err "not define-type-alias")]))
 
 (define (type-check forms0)
-  (begin-with-definitions
-    (define forms (syntax->list forms0))
-    (define-values (type-aliases struct-defs stx-defs0 val-defs0 provs reqs)
-      (filter-multiple
-       forms
-       (internal-syntax-pred define-type-alias-internal)
-       (lambda (e) (or ((internal-syntax-pred define-typed-struct-internal) e)
-                       ((internal-syntax-pred define-typed-struct/exec-internal) e)))
-       parse-syntax-def
-       parse-def
-       provide?
-       define/fixup-contract?))
-    (for-each (compose register-type-alias parse-type-alias) type-aliases)
-    ;; add the struct names to the type table
-    (for-each (compose add-type-name! names-of-struct) struct-defs)
-    ;; resolve all the type aliases, and error if there are cycles
-    (resolve-type-aliases parse-type)
-    ;; do pass 1, and collect the defintions
-    (define defs (apply append (filter list? (map tc-toplevel/pass1 forms))))
-    ;; separate the definitions into structures we'll handle for provides
-    (define def-tbl
-      (for/fold ([h (make-immutable-free-id-table)])
-        ([def (in-list defs)])
-        (dict-set h (binding-name def) def)))
-    ;; typecheck the expressions and the rhss of defintions
-    (for-each tc-toplevel/pass2 forms)
-    ;; check that declarations correspond to definitions
-    (check-all-registered-types)
-    ;; report delayed errors
-    (report-all-errors)
-    (define syntax-provide? #f)
-    (define provide-tbl
-      (for/fold ([h (make-immutable-free-id-table)]) ([p (in-list provs)])
-        (define-syntax-class unknown-provide-form
-         (pattern
-          (~and name
-           (~or (~datum protect) (~datum for-syntax) (~datum for-label) (~datum for-meta)
-                (~datum struct) (~datum all-from) (~datum all-from-except)
-                (~datum all-defined) (~datum all-defined-except)
-                (~datum prefix-all-defined) (~datum prefix-all-defined-except)
-                (~datum expand)))))
-        (syntax-parse p #:literals (#%provide)
-          [(#%provide form ...)
-           (for/fold ([h h]) ([f (syntax->list #'(form ...))])
-             (parameterize ([current-orig-stx f])
-               (syntax-parse f
-                 [i:id
-                  (when (def-stx-binding? (dict-ref def-tbl #'i #f))
-                    (set! syntax-provide? #t))
-                  (dict-set h #'i #'i)]
-                 [((~datum rename) in out)
-                  (when (def-stx-binding? (dict-ref def-tbl #'in #f))
-                    (set! syntax-provide? #t))
-                  (dict-set h #'in #'out)]
-                 [(name:unknown-provide-form . _)
-                  (tc-error "provide: ~a not supported by Typed Racket" (syntax-e #'name.name))]
-                 [_ (int-err "unknown provide form")])))]
-          [_ (int-err "non-provide form! ~a" (syntax->datum p))])))
-    ;; compute the new provides
+  (define forms (syntax->list forms0))
+  (define-values (type-aliases struct-defs stx-defs0 val-defs0 provs reqs)
+    (filter-multiple
+     forms
+     (internal-syntax-pred define-type-alias-internal)
+     (lambda (e) (or ((internal-syntax-pred define-typed-struct-internal) e)
+                     ((internal-syntax-pred define-typed-struct/exec-internal) e)))
+     parse-syntax-def
+     parse-def
+     provide?
+     define/fixup-contract?))
+  (do-time "Form splitting done")
+  (for-each (compose register-type-alias parse-type-alias) type-aliases)
+  ;; add the struct names to the type table
+  (for-each (compose add-type-name! names-of-struct) struct-defs)
+  ;; resolve all the type aliases, and error if there are cycles
+  (resolve-type-aliases parse-type)
+  (do-time "Starting pass1")
+  ;; do pass 1, and collect the defintions
+  (define defs (apply append (filter list? (map tc-toplevel/pass1 forms))))
+  (do-time "Finished pass1")
+  ;; separate the definitions into structures we'll handle for provides
+  (define def-tbl
+    (for/fold ([h (make-immutable-free-id-table)])
+      ([def (in-list defs)])
+      (dict-set h (binding-name def) def)))
+  ;; typecheck the expressions and the rhss of defintions
+  (do-time "Starting pass2")
+  (for-each tc-toplevel/pass2 forms)
+  (do-time "Finished pass2")
+  ;; check that declarations correspond to definitions
+  (check-all-registered-types)
+  ;; report delayed errors
+  (report-all-errors)
+  (define syntax-provide? #f)
+  (define provide-tbl
+    (for/fold ([h (make-immutable-free-id-table)]) ([p (in-list provs)])
+      (define-syntax-class unknown-provide-form
+        (pattern
+         (~and name
+               (~or (~datum protect) (~datum for-syntax) (~datum for-label) (~datum for-meta)
+                    (~datum struct) (~datum all-from) (~datum all-from-except)
+                    (~datum all-defined) (~datum all-defined-except)
+                    (~datum prefix-all-defined) (~datum prefix-all-defined-except)
+                    (~datum expand)))))
+      (syntax-parse p #:literals (#%provide)
+        [(#%provide form ...)
+         (for/fold ([h h]) ([f (syntax->list #'(form ...))])
+           (parameterize ([current-orig-stx f])
+             (syntax-parse f
+               [i:id
+                (when (def-stx-binding? (dict-ref def-tbl #'i #f))
+                  (set! syntax-provide? #t))
+                (dict-set h #'i #'i)]
+               [((~datum rename) in out)
+                (when (def-stx-binding? (dict-ref def-tbl #'in #f))
+                  (set! syntax-provide? #t))
+                (dict-set h #'in #'out)]
+               [(name:unknown-provide-form . _)
+                (tc-error "provide: ~a not supported by Typed Racket" (syntax-e #'name.name))]
+               [_ (int-err "unknown provide form")])))]
+        [_ (int-err "non-provide form! ~a" (syntax->datum p))])))
+  ;; compute the new provides
+  (define new-stx 
     (with-syntax*
         ([the-variable-reference (generate-temporary #'blame)]
          [(new-provs ...)
@@ -319,11 +324,13 @@
           #,(if (null? (syntax-e #'(new-provs ...)))
                 #'(begin)
                 #'(define the-variable-reference (quote-module-name)))
-           #,(env-init-code syntax-provide? provide-tbl def-tbl)
-           #,(tname-env-init-code)
-           #,(talias-env-init-code)
-           (begin-for-syntax #,(make-struct-table-code))
-           (begin new-provs ...)))))
+          #,(env-init-code syntax-provide? provide-tbl def-tbl)
+          #,(tname-env-init-code)
+          #,(talias-env-init-code)
+          (begin-for-syntax #,(make-struct-table-code))
+          (begin new-provs ...))))
+  (do-time "finished provide generation")
+  new-stx)
 
 ;; typecheck a whole module
 ;; syntax -> syntax
diff --git a/collects/typed-scheme/typecheck/typechecker.rkt b/collects/typed-racket/typecheck/typechecker.rkt
similarity index 77%
rename from collects/typed-scheme/typecheck/typechecker.rkt
rename to collects/typed-racket/typecheck/typechecker.rkt
index 9a2d29622b..efd70847c2 100644
--- a/collects/typed-scheme/typecheck/typechecker.rkt
+++ b/collects/typed-racket/typecheck/typechecker.rkt
@@ -1,9 +1,8 @@
-#lang scheme/base
+#lang racket/base
 
-(require "../utils/utils.rkt")
-(require (utils unit-utils)
-         mzlib/trace
-         (only-in scheme/unit
+(require "../utils/utils.rkt"
+         racket/trace
+         (only-in racket/unit
                   provide-signature-elements
                   define-values/invoke-unit/infer link)
          "signatures.rkt"
diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-racket/typed-racket.rkt
similarity index 61%
rename from collects/typed-scheme/typed-scheme.rkt
rename to collects/typed-racket/typed-racket.rkt
index a60231ad42..0724da95e3 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-racket/typed-racket.rkt
@@ -1,10 +1,11 @@
 #lang racket/base
 
-(require (for-syntax racket/base
-                     "utils/utils.rkt" ;; only for timing/debugging
-                     ;; these requires are needed since their code
-                     ;; appears in the residual program
-                     "typecheck/renamer.rkt" "types/type-table.rkt"))
+(require
+ (for-syntax racket/base "utils/utils.rkt") ;; only for timing/debugging
+ ;; the below requires are needed since they provide identifiers
+ ;; that may appear in the residual program
+ (for-syntax "typecheck/renamer.rkt" "types/type-table.rkt")
+ "utils/any-wrap.rkt" unstable/contract)
 
 (provide (rename-out [module-begin #%module-begin]
                      [top-interaction #%top-interaction]
@@ -18,15 +19,15 @@
 (define-for-syntax (do-standard-inits)
   (unless initialized
     (do-time "Starting initialization")
-    ((dynamic-require 'typed-scheme/base-env/base-structs 'initialize-structs))
+    ((dynamic-require 'typed-racket/base-env/base-structs 'initialize-structs))
     (do-time "Finshed base-structs")
-    ((dynamic-require 'typed-scheme/base-env/base-env-indexing 'initialize-indexing))
+    ((dynamic-require 'typed-racket/base-env/base-env-indexing 'initialize-indexing))
     (do-time "Finshed base-env-indexing")
-    ((dynamic-require 'typed-scheme/base-env/base-env 'init))
+    ((dynamic-require 'typed-racket/base-env/base-env 'init))
     (do-time "Finshed base-env")
-    ((dynamic-require 'typed-scheme/base-env/base-env-numeric 'init))
+    ((dynamic-require 'typed-racket/base-env/base-env-numeric 'init))
     (do-time "Finshed base-env-numeric")
-    ((dynamic-require 'typed-scheme/base-env/base-special-env 'initialize-special))    
+    ((dynamic-require 'typed-racket/base-env/base-special-env 'initialize-special))
     (do-time "Finished base-special-env")
     (set! initialized #t)))
 
@@ -35,7 +36,7 @@
     (define-syntax (name stx)
       (do-time (format "Calling ~a driver" 'name))
       (do-standard-inits)
-      (define f (dynamic-require 'typed-scheme/core 'sym))
+      (define f (dynamic-require 'typed-racket/core 'sym))
       (do-time (format "Loaded core ~a" 'sym))
       (begin0 (f stx)
               (do-time "Finished, returning to Racket")))
diff --git a/collects/typed-scheme/typed-reader.rkt b/collects/typed-racket/typed-reader.rkt
similarity index 100%
rename from collects/typed-scheme/typed-reader.rkt
rename to collects/typed-racket/typed-reader.rkt
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-racket/types/abbrev.rkt
similarity index 99%
rename from collects/typed-scheme/types/abbrev.rkt
rename to collects/typed-racket/types/abbrev.rkt
index 8e107d2bd3..a8bccb7720 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-racket/types/abbrev.rkt
@@ -164,7 +164,7 @@
   (make-Base 'Compiled-Non-Module-Expression
              #'(and/c    compiled-expression? (not/c  compiled-module-expression?))
                (conjoin  compiled-expression? (negate compiled-module-expression?))
-             #'-CompiledExpression))
+             #'-Compiled-Non-Module-Expression))
 (define -Compiled-Expression (*Un -Compiled-Module-Expression -Compiled-Non-Module-Expression))
 (define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag? continuation-prompt-tag? #'-Prompt-Tag))
 (define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set))
diff --git a/collects/typed-scheme/types/comparison.rkt b/collects/typed-racket/types/comparison.rkt
similarity index 100%
rename from collects/typed-scheme/types/comparison.rkt
rename to collects/typed-racket/types/comparison.rkt
diff --git a/collects/typed-scheme/types/convenience.rkt b/collects/typed-racket/types/convenience.rkt
similarity index 100%
rename from collects/typed-scheme/types/convenience.rkt
rename to collects/typed-racket/types/convenience.rkt
diff --git a/collects/typed-scheme/types/filter-ops.rkt b/collects/typed-racket/types/filter-ops.rkt
similarity index 100%
rename from collects/typed-scheme/types/filter-ops.rkt
rename to collects/typed-racket/types/filter-ops.rkt
diff --git a/collects/typed-scheme/types/numeric-predicates.rkt b/collects/typed-racket/types/numeric-predicates.rkt
similarity index 79%
rename from collects/typed-scheme/types/numeric-predicates.rkt
rename to collects/typed-racket/types/numeric-predicates.rkt
index 4224f3e30b..5e38bded86 100644
--- a/collects/typed-scheme/types/numeric-predicates.rkt
+++ b/collects/typed-racket/types/numeric-predicates.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require unstable/function racket/unsafe/ops)
+(require racket/unsafe/ops)
 
 (provide index? exact-rational?)
 
@@ -11,4 +11,4 @@
 ;; we're safe from fixnum size issues on different platforms.
 (define (index? x) (and (fixnum? x) (unsafe-fx>= x 0) (fixnum? (* x 4))))
 
-(define exact-rational? (conjoin rational? exact?))
+(define (exact-rational? x) (and (rational? x) (exact? x)))
diff --git a/collects/typed-scheme/types/numeric-tower.rkt b/collects/typed-racket/types/numeric-tower.rkt
similarity index 100%
rename from collects/typed-scheme/types/numeric-tower.rkt
rename to collects/typed-racket/types/numeric-tower.rkt
diff --git a/collects/typed-scheme/types/printer.rkt b/collects/typed-racket/types/printer.rkt
similarity index 98%
rename from collects/typed-scheme/types/printer.rkt
rename to collects/typed-racket/types/printer.rkt
index 0a525c6e3c..0f2bd311fb 100644
--- a/collects/typed-scheme/types/printer.rkt
+++ b/collects/typed-racket/types/printer.rkt
@@ -1,7 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require racket/require racket/match racket/list racket/string
-         unstable/sequence
+(require racket/require racket/match unstable/sequence
          (prefix-in s: srfi/1)
          (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
                   "rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt"
@@ -173,7 +172,7 @@
          [(list a b ...)
           (format "(case-lambda ~a~a)"
                   (format-arr a)
-                  (string-append* (map format-arr b)))]))]))
+                  (apply string-append (map format-arr b)))]))]))
 
 ;; print out a type
 ;; print-type : Type Port Boolean -> Void
@@ -197,7 +196,7 @@
     [(Name: stx) (fp "~a" (syntax-e stx))]
     [(app has-name? (? values name))
      (fp "~a" name)]
-    [(StructTop: st) (fp "~a" st)]
+    [(StructTop: st) (fp "(struct-top: ~a)" st)]
     [(BoxTop:) (fp "Box")]
     [(ChannelTop:) (fp "Channel")]
     [(ThreadCellTop:) (fp "ThreadCell")]
diff --git a/collects/typed-scheme/types/remove-intersect.rkt b/collects/typed-racket/types/remove-intersect.rkt
similarity index 88%
rename from collects/typed-scheme/types/remove-intersect.rkt
rename to collects/typed-racket/types/remove-intersect.rkt
index 5101253e52..a0564e5fa1 100644
--- a/collects/typed-scheme/types/remove-intersect.rkt
+++ b/collects/typed-racket/types/remove-intersect.rkt
@@ -26,6 +26,10 @@
          [(list (Name: n) (Name: n*))
           (or (free-identifier=? n n*)
               (overlap (resolve-once t1) (resolve-once t2)))]
+         [(list _ (Name: _))
+           (overlap t1 (resolve-once t2))]
+         [(list (Name: _) _)
+           (overlap (resolve-once t1) t2)]
          [(list (? Mu?) _) (overlap (unfold t1) t2)]
          [(list _ (? Mu?)) (overlap t1 (unfold t2))]
 
@@ -76,16 +80,9 @@
          [(list (Struct: n #f flds _ _ _ _ _)
                 (StructTop: (Struct: n* #f flds* _ _ _ _ _)))
           #f]
-         [(list (and t1 (Struct: n p flds _ _ _ _ _))
-                (and t2 (Struct: n* p* flds* _ _ _ _ _)))
-          (let ([p1 (if (Name? p) (resolve-name p) p)]
-                [p2 (if (Name? p*) (resolve-name p*) p*)])
-            (or (and p2 (overlap t1 p2))
-                (and p1 (overlap t2 p1))
-                (and (= (length flds) (length flds*))
-                     (for/and ([f flds] [f* flds*])
-                       (match* (f f*)
-                               [((fld: t _ _) (fld: t* _ _)) (overlap t t*)])))))]
+         [(list (and t1 (Struct: _ _ _ _ _ _ _ _))
+                (and t2 (Struct: _ _ _ _ _ _ _ _)))
+          (or (subtype t1 t2) (subtype t2 t1))]
          [(list (== (-val eof))
                 (Function: _))
           #f]
diff --git a/collects/typed-scheme/types/resolve.rkt b/collects/typed-racket/types/resolve.rkt
similarity index 100%
rename from collects/typed-scheme/types/resolve.rkt
rename to collects/typed-racket/types/resolve.rkt
diff --git a/collects/typed-scheme/types/substitute.rkt b/collects/typed-racket/types/substitute.rkt
similarity index 100%
rename from collects/typed-scheme/types/substitute.rkt
rename to collects/typed-racket/types/substitute.rkt
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-racket/types/subtype.rkt
similarity index 75%
rename from collects/typed-scheme/types/subtype.rkt
rename to collects/typed-racket/types/subtype.rkt
index 224e9c2f9c..4e0c646685 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-racket/types/subtype.rkt
@@ -2,14 +2,14 @@
 (require "../utils/utils.rkt"
          (rep type-rep filter-rep object-rep rep-utils)
          (utils tc-utils)
-	 (types utils comparison resolve abbrev numeric-tower substitute)
+         (types utils comparison resolve abbrev numeric-tower substitute)
          (env type-name-env)
          (only-in (infer infer-dummy) unify)
          racket/match unstable/match
          racket/function
          (rename-in racket/contract
                     [-> c->] [->* c->*])
-	 (for-syntax racket/base syntax/parse))
+         (for-syntax racket/base syntax/parse))
 
 ;; exn representing failure of subtyping
 ;; s,t both types
@@ -91,13 +91,13 @@
     [(_ init (s1:sub* . args1) (s:sub* . args) ...)
      (with-syntax ([(A* ... A-last) (generate-temporaries #'(s1 s ...))])
        (with-syntax ([(clauses ...)
-		      (for/list ([s (syntax->list #'(s1 s ...))]
-				 [args (syntax->list #'(args1 args ...))]
-				 [A (syntax->list #'(init A* ...))]
-				 [A-next (syntax->list #'(A* ... A-last))])
-			 #`[#,A-next (#,s #,A . #,args)])])
-	#'(let* (clauses ...)
-	    A-last)))]))
+                      (for/list ([s (syntax->list #'(s1 s ...))]
+                                 [args (syntax->list #'(args1 args ...))]
+                                 [A (syntax->list #'(init A* ...))]
+                                 [A-next (syntax->list #'(A* ... A-last))])
+                         #`[#,A-next (#,s #,A . #,args)])])
+        #'(let* (clauses ...)
+            A-last)))]))
 
 (define (kw-subtypes* A0 t-kws s-kws)
   (let loop ([A A0] [t t-kws] [s s-kws])
@@ -245,25 +245,25 @@
        [(and (symbol? ks) (symbol? kt) (not (eq? ks kt))) (fail! s t)]
        [(and (symbol? ks) (pair? kt) (not (memq ks kt))) (fail! s t)]
        [(and (pair? ks) (pair? kt)
-	     (for/and ([i (in-list ks)]) (not (memq i kt))))
-	(fail! s t)]
+             (for/and ([i (in-list ks)]) (not (memq i kt))))
+        (fail! s t)]
        [else
-	(let* ([A0 (remember s t A)])
-	  (parameterize ([current-seen A0])
+        (let* ([A0 (remember s t A)])
+          (parameterize ([current-seen A0])
             (match* (s t)
-	      [(_ (Univ:)) A0]
-	      ;; error is top and bot
-	      [(_ (Error:)) A0]
-	      [((Error:) _) A0]
-	      ;; (Un) is bot
-	      [(_ (Union: (list))) (fail! s t)]
-	      [((Union: (list)) _) A0]
-	      ;; value types
-	      [((Value: v1) (Value: v2)) (=> unmatch) (if (equal? v1 v2) A0 (unmatch))]
+              [(_ (Univ:)) A0]
+              ;; error is top and bot
+              [(_ (Error:)) A0]
+              [((Error:) _) A0]
+              ;; (Un) is bot
+              [(_ (Union: (list))) (fail! s t)]
+              [((Union: (list)) _) A0]
+              ;; value types
+              [((Value: v1) (Value: v2)) (=> unmatch) (if (equal? v1 v2) A0 (unmatch))]
               ;; values are subtypes of their "type"
-	      [((Value: v) (Base: _ _ pred _)) (if (pred v) A0 (fail! s t))]
-	      ;; tvars are equal if they are the same variable
-	      [((F: t) (F: t*)) (if (eq? t t*) A0 (fail! s t))]
+              [((Value: v) (Base: _ _ pred _)) (if (pred v) A0 (fail! s t))]
+              ;; tvars are equal if they are the same variable
+              [((F: t) (F: t*)) (if (eq? t t*) A0 (fail! s t))]
               ;; Avoid needing to resolve things that refer to different structs.
               ;; Saves us from non-termination
               ;; Must happen *before* the sequence cases, which sometimes call `resolve' in match expanders
@@ -311,63 +311,80 @@
                (or (arr-subtype*/no-fail A0 (combine-arrs arr1) arr2)
                    (supertype-of-one/arr A0 arr2 arr1)
                    (fail! s t))]
-	      ;; case-lambda
-	      [((Function: arr1) (Function: arr2))
-	       (when (null? arr1) (fail! s t))
-	       (let loop-arities ([A* A0]
-				  [arr2 arr2])
-		 (cond
-		  [(null? arr2) A*]
-		  [(supertype-of-one/arr A* (car arr2) arr1) => (lambda (A) (loop-arities A (cdr arr2)))]
-		  [else (fail! s t)]))]
-	      ;; recur structurally on pairs
-	      [((Pair: a d) (Pair: a* d*))
-	       (let ([A1 (subtype* A0 a a*)])
-		 (and A1 (subtype* A1 d d*)))]
+              ;; case-lambda
+              [((Function: arr1) (Function: arr2))
+               (when (null? arr1) (fail! s t))
+               (let loop-arities ([A* A0]
+                                  [arr2 arr2])
+                 (cond
+                  [(null? arr2) A*]
+                  [(supertype-of-one/arr A* (car arr2) arr1) => (lambda (A) (loop-arities A (cdr arr2)))]
+                  [else (fail! s t)]))]
+              ;; recur structurally on pairs
+              [((Pair: a d) (Pair: a* d*))
+               (let ([A1 (subtype* A0 a a*)])
+                 (and A1 (subtype* A1 d d*)))]
               ;; recur structurally on dotted lists, assuming same bounds
               [((ListDots: s-dty dbound) (ListDots: t-dty dbound))
                (subtype* A0 s-dty t-dty)]
               [((ListDots: s-dty dbound) (Listof: t-elem))
                (subtype* A0 (substitute Univ dbound s-dty) t-elem)]
-	      ;; quantification over two types preserves subtyping
-	      [((Poly: ns b1) (Poly: ms b2))
-	       (=> unmatch)
-	       (unless (= (length ns) (length ms))
-		       (unmatch))
-	       (subtype* A0 b1 (subst-all (make-simple-substitution ms (map make-F ns)) b2))]
-	      [((Refinement: par _ _) t)
+              ;; quantification over two types preserves subtyping
+              [((Poly: ns b1) (Poly: ms b2))
+               (=> unmatch)
+               (unless (= (length ns) (length ms))
+                       (unmatch))
+               (subtype* A0 b1 (subst-all (make-simple-substitution ms (map make-F ns)) b2))]
+              [((Refinement: par _ _) t)
                (subtype* A0 par t)]
-	      ;; use unification to see if we can use the polytype here
-	      [((Poly: vs b) s)
-	       (=> unmatch)
-	       (if (unify vs (list b) (list s)) A0 (unmatch))]
-	      [(s (Poly: vs b))
-	       (=> unmatch)
-	       (if (null? (fv b)) (subtype* A0 s b) (unmatch))]
-	      ;; rec types, applications and names (that aren't the same)
-	      [((? needs-resolving? s) other)
+              ;; use unification to see if we can use the polytype here
+              [((Poly: vs b) s)
+               (=> unmatch)
+               (if (unify vs (list b) (list s)) A0 (unmatch))]
+              [(s (Poly: vs b))
+               (=> unmatch)
+               (if (null? (fv b)) (subtype* A0 s b) (unmatch))]
+              ;; rec types, applications and names (that aren't the same)
+              [((? needs-resolving? s) other)
                (let ([s* (resolve-once s)])
                  (if (Type? s*) ;; needed in case this was a name that hasn't been resolved yet
                      (subtype* A0 s* other)
                      (fail! s t)))]
-	      [(other (? needs-resolving? t))
+              [(other (? needs-resolving? t))
                (let ([t* (resolve-once t)])
                  (if (Type? t*) ;; needed in case this was a name that hasn't been resolved yet
                      (subtype* A0 other t*)
                      (fail! s t)))]
-	      ;; for unions, we check the cross-product
-	      [((Union: es) t) (or (and (andmap (lambda (elem) (subtype* A0 elem t)) es) A0)
-                                   (fail! s t))]
-	      [(s (Union: es)) (or (and (ormap (lambda (elem) (subtype*/no-fail A0 s elem)) es) A0)
-                                   (fail! s t))]
-	      ;; subtyping on immutable structs is covariant
-	      [((Struct: nm _ flds proc _ _ _ _) (Struct: nm* _ flds* proc* _ _ _ _)) (=> nevermind)
+              ;; for unions, we check the cross-product
+              ;; some special cases for better performance
+              [((Union: (list e1 e2)) t)
+               (if (and (subtype* A0 e1 t) (subtype* A0 e2 t))
+                   A0
+                   (fail! s t))]
+              [((Union: (list e1 e2 e3)) t)
+               (if (and (subtype* A0 e1 t) (subtype* A0 e2 t) (subtype* A0 e3 t))
+                   A0
+                   (fail! s t))]
+              [((Union: es) t)
+               (if (for/and ([elem (in-list es)])
+                     (subtype* A0 elem t))
+                   A0
+                   (fail! s t))]
+              [(s (Union: es))
+               (if (for/or ([elem (in-list es)])
+                     (with-handlers ([exn:subtype? (lambda _ #f)])
+                       (subtype* A0 s elem)))
+                   A0
+                   (fail! s t))]
+              ;; subtyping on immutable structs is covariant
+              [((Struct: nm _ flds proc _ _ _ _) (Struct: nm* _ flds* proc* _ _ _ _)) (=> nevermind)
                (unless (free-identifier=? nm nm*) (nevermind))
                (let ([A (cond [(and proc proc*) (subtype* proc proc*)]
                               [proc* (fail! proc proc*)]
                               [else A0])])
                  (subtype/flds* A flds flds*))]
-              [((Struct: _ _ _ _ _ _ _ _) (StructTop: (== s type-equal?)))
+              [((Struct: nm _ _ _ _ _ _ _) (StructTop: (Struct: nm* _ _ _ _ _ _ _))) (=> nevermind)
+               (unless (free-identifier=? nm nm*) (nevermind))
                A0]
               ;ephemerons are covariant
               [((Ephemeron: s) (Ephemeron: t))
@@ -384,37 +401,37 @@
                (if (andmap (lambda (e0) (type-equal? e0 e*)) e) A0 (fail! s t))]
               [((MPair: _ _) (MPairTop:)) A0]
               [((Hashtable: _ _) (HashtableTop:)) A0]
-	      ;; subtyping on structs follows the declared hierarchy
-	      [((Struct: nm (? Type? parent) flds proc _ _ _ _) other)
+              ;; subtyping on structs follows the declared hierarchy
+              [((Struct: nm (? Type? parent) flds proc _ _ _ _) other)
                ;(dprintf "subtype - hierarchy : ~a ~a ~a\n" nm parent other)
-	       (subtype* A0 parent other)]
-	      ;; Promises are covariant
-          [((Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t) _ _ _ _ _)
-            (Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t*) _ _ _ _ _))
-           (subtype* A0 t t*)]
-	      ;; subtyping on values is pointwise
-	      [((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
+               (subtype* A0 parent other)]
+              ;; Promises are covariant
+              [((Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t) _ _ _ _ _)
+                (Struct: (? (lambda (n) (free-identifier=? n promise-id))) _ (list t*) _ _ _ _ _))
+               (subtype* A0 t t*)]
+              ;; subtyping on values is pointwise
+              [((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
               ;; trivial case for Result
               [((Result: t f o) (Result: t* f o))
                (subtype* A0 t t*)]
               ;; we can ignore interesting results
               [((Result: t f o) (Result: t* (FilterSet: (Top:) (Top:)) (Empty:)))
                (subtype* A0 t t*)]
-	      ;; subtyping on other stuff
-	      [((Syntax: t) (Syntax: t*))
-	       (subtype* A0 t t*)]
+              ;; subtyping on other stuff
+              [((Syntax: t) (Syntax: t*))
+               (subtype* A0 t t*)]
               [((Future: t) (Future: t*))
                (subtype* A0 t t*)]
-	      [((Instance: t) (Instance: t*))
-	       (subtype* A0 t t*)]
+              [((Instance: t) (Instance: t*))
+               (subtype* A0 t t*)]
               [((Class: '() '() (list (and s  (list names  meths )) ...))
                 (Class: '() '() (list (and s* (list names* meths*)) ...)))
                (for/fold ([A A0])
                          ([n names*] [m meths*])
                          (cond [(assq n s) => (lambda (spec) (subtype* A (cadr spec) m))]
                                [else (fail! s t)]))]
-	      ;; otherwise, not a subtype
-	      [(_ _) (fail! s t) #;(dprintf "failed")])))]))))
+              ;; otherwise, not a subtype
+              [(_ _) (fail! s t) #;(dprintf "failed")])))]))))
 
   (define (type-compare? a b)
   (and (subtype a b) (subtype b a)))
diff --git a/collects/typed-scheme/types/type-table.rkt b/collects/typed-racket/types/type-table.rkt
similarity index 97%
rename from collects/typed-scheme/types/type-table.rkt
rename to collects/typed-racket/types/type-table.rkt
index f1bbc576cb..5b19d7f860 100644
--- a/collects/typed-scheme/types/type-table.rkt
+++ b/collects/typed-racket/types/type-table.rkt
@@ -1,12 +1,14 @@
 #lang racket/base
 
-(require racket/contract syntax/id-table racket/dict racket/match mzlib/pconvert
+(require syntax/id-table racket/dict racket/match mzlib/pconvert
          "../utils/utils.rkt"
+         (contract-req)
          (rep type-rep object-rep)
          (only-in (types utils) tc-results?)
          (utils tc-utils)
          (env init-envs))
 
+
 (define table (make-hasheq))
 
 (define (reset-type-table) (set! table (make-hasheq)))
diff --git a/collects/typed-scheme/types/union.rkt b/collects/typed-racket/types/union.rkt
similarity index 91%
rename from collects/typed-scheme/types/union.rkt
rename to collects/typed-racket/types/union.rkt
index e62fef13ed..8a47bf1b4f 100644
--- a/collects/typed-scheme/types/union.rkt
+++ b/collects/typed-racket/types/union.rkt
@@ -1,12 +1,14 @@
-#lang scheme/base
+#lang racket/base
 
 (require "../utils/utils.rkt"
          (rep type-rep rep-utils)
-	 (utils tc-utils)
-     (prefix-in c: racket/contract)
-	 (types utils subtype abbrev printer comparison)
+         (utils tc-utils)
+         (contract-req)
+         (types utils subtype abbrev printer comparison)
          racket/match)
 
+
+
 (provide/cond-contract
  [Un (() #:rest (c:listof Type/c) . c:->* . Type/c)])
 
diff --git a/collects/typed-scheme/types/utils.rkt b/collects/typed-racket/types/utils.rkt
similarity index 100%
rename from collects/typed-scheme/types/utils.rkt
rename to collects/typed-racket/types/utils.rkt
diff --git a/collects/typed-scheme/utils/any-wrap.rkt b/collects/typed-racket/utils/any-wrap.rkt
similarity index 92%
rename from collects/typed-scheme/utils/any-wrap.rkt
rename to collects/typed-racket/utils/any-wrap.rkt
index 3e88dc2e87..9974543c2e 100644
--- a/collects/typed-scheme/utils/any-wrap.rkt
+++ b/collects/typed-racket/utils/any-wrap.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require racket/match scheme/vector scheme/contract)
+(require racket/match racket/vector racket/contract/base racket/contract/combinator)
 
 (define-struct any-wrap (val)
   #:property prop:custom-write
diff --git a/collects/typed-scheme/utils/arm.rkt b/collects/typed-racket/utils/arm.rkt
similarity index 100%
rename from collects/typed-scheme/utils/arm.rkt
rename to collects/typed-racket/utils/arm.rkt
diff --git a/collects/typed-scheme/utils/disarm.rkt b/collects/typed-racket/utils/disarm.rkt
similarity index 100%
rename from collects/typed-scheme/utils/disarm.rkt
rename to collects/typed-racket/utils/disarm.rkt
diff --git a/collects/typed-scheme/utils/require-contract.rkt b/collects/typed-racket/utils/require-contract.rkt
similarity index 95%
rename from collects/typed-scheme/utils/require-contract.rkt
rename to collects/typed-racket/utils/require-contract.rkt
index 10a1451953..e39a261e1d 100644
--- a/collects/typed-scheme/utils/require-contract.rkt
+++ b/collects/typed-racket/utils/require-contract.rkt
@@ -1,10 +1,9 @@
-#lang scheme/base
+#lang racket/base
 
-(require scheme/contract
+(require racket/contract/region racket/contract/base
          syntax/location
-         (for-syntax scheme/base
+         (for-syntax racket/base
                      syntax/parse
-                     racket/syntax
                      (prefix-in tr: "../private/typed-renaming.rkt")))
 
 (provide require/contract define-ignored)
diff --git a/collects/typed-scheme/utils/stxclass-util.rkt b/collects/typed-racket/utils/stxclass-util.rkt
similarity index 96%
rename from collects/typed-scheme/utils/stxclass-util.rkt
rename to collects/typed-racket/utils/stxclass-util.rkt
index f939bfae83..a3efaec137 100644
--- a/collects/typed-scheme/utils/stxclass-util.rkt
+++ b/collects/typed-racket/utils/stxclass-util.rkt
@@ -1,8 +1,8 @@
-#lang scheme/base
+#lang racket/base
 
 (require (except-in syntax/parse id keyword)
          (for-syntax syntax/parse
-                     scheme/base
+                     racket/base
                      (only-in racket/syntax generate-temporary)))
 
 (provide (except-out (all-defined-out) id keyword)
diff --git a/collects/typed-scheme/utils/syntax-traversal.rkt b/collects/typed-racket/utils/syntax-traversal.rkt
similarity index 100%
rename from collects/typed-scheme/utils/syntax-traversal.rkt
rename to collects/typed-racket/utils/syntax-traversal.rkt
diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-racket/utils/tc-utils.rkt
similarity index 98%
rename from collects/typed-scheme/utils/tc-utils.rkt
rename to collects/typed-racket/utils/tc-utils.rkt
index 7b8b88db7b..2ad3a20c17 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-racket/utils/tc-utils.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 #|
 This file is for utilities that are only useful for Typed Racket, but
@@ -7,7 +7,7 @@ don't depend on any other portion of the system
 
 (provide (all-defined-out))
 (require "syntax-traversal.rkt" racket/dict
-	 syntax/parse (for-syntax scheme/base syntax/parse) racket/match)
+	 syntax/parse (for-syntax racket/base syntax/parse) racket/match)
 
 ;; a parameter representing the original location of the syntax being
 ;; currently checked
diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-racket/utils/utils.rkt
similarity index 89%
rename from collects/typed-scheme/utils/utils.rkt
rename to collects/typed-racket/utils/utils.rkt
index 0ed49bfa16..99d70f2a3e 100644
--- a/collects/typed-scheme/utils/utils.rkt
+++ b/collects/typed-racket/utils/utils.rkt
@@ -6,9 +6,9 @@ at least theoretically.
 |#
 
 (require (for-syntax racket/base syntax/parse racket/string)
-         racket/contract racket/require-syntax
-	 racket/provide-syntax racket/unit (prefix-in d: unstable/debug)
-	 racket/struct-info racket/pretty mzlib/pconvert syntax/parse)
+         racket/require-syntax racket/unit
+         racket/provide-syntax (prefix-in d: unstable/debug)
+         racket/struct-info)
 
 ;; to move to unstable
 (provide reverse-begin list-update list-set debugf debugging? dprintf)
@@ -27,6 +27,13 @@ at least theoretically.
 
 (define optimize? (make-parameter #t))
 (define-for-syntax enable-contracts? #f)
+
+(define-syntax do-contract-req
+  (if enable-contracts?
+      (syntax-rules () [(_) (require racket/contract/base)])
+      (syntax-rules () [(_) (begin)])))
+(do-contract-req)
+
 (define show-input? (make-parameter #f))
 
 ;; fancy require syntax
@@ -46,7 +53,7 @@ at least theoretically.
 					,(datum->syntax
 					  #f
 					  (string-join
-					   (list "typed-scheme"
+					   (list "typed-racket"
 						 (symbol->string (syntax-e #'nm))
 						 (string-append (symbol->string (syntax-e id)) ".rkt"))
 					   "/")
@@ -67,7 +74,7 @@ at least theoretically.
 					,(datum->syntax
 					  #f
 					  (string-join
-					   (list "typed-scheme"
+					   (list "typed-racket"
 						 (symbol->string (syntax-e #'nm))
 						 (string-append (symbol->string (syntax-e id)) ".rkt"))
 					   "/")
@@ -124,7 +131,7 @@ at least theoretically.
               (error 'start-timing "Timing already started"))
             (set!-last-time (current-process-milliseconds))
             (set!-initial-time last-time)
-            (log-debug (format "TR Timing: ~a at ~a" (pad "Starting" 40 #\space) initial-time)))])
+            (log-debug (format "TR Timing: ~a at ~a" (pad "Starting" 32 #\space) initial-time)))])
        (syntax-rules ()
          [(_ msg)
           (begin
@@ -133,7 +140,7 @@ at least theoretically.
             (let* ([t (current-process-milliseconds)]
                    [old last-time]
                    [diff (- t old)]
-                   [new-msg (pad msg 40 #\space)])
+                   [new-msg (pad msg 32 #\space)])
               (set!-last-time t)
               (log-debug (format "TR Timing: ~a at ~a\tlast step: ~a\ttotal: ~a" new-msg t diff (- t initial-time)))))]))
       (values (lambda _ #'(void)) (lambda _ #'(void)))))
@@ -152,13 +159,6 @@ at least theoretically.
   print-type* print-filter* print-latentfilter* print-object* print-latentobject*
   print-pathelem*)
 
-(define (pseudo-printer s port mode)
-  (parameterize ([current-output-port port]
-                 [show-sharing #f]
-                 [booleans-as-true/false #f]
-                 [constructor-style-printing #t])
-    (pretty-print (print-convert s))))
-
 (define custom-printer (make-parameter #t))
 
 (define-syntax (define-struct/printer stx)
@@ -167,7 +167,13 @@ at least theoretically.
      #`(define-struct name (flds ...)
          #:property prop:custom-print-quotable 'never
          #:property prop:custom-write
-         (lambda (a b c) (if (custom-printer) (printer a b c) (pseudo-printer a b c)))
+         (lambda (a b c) (if (custom-printer)
+                             (printer a b c)
+                             ;; ok to make this case slow, it never runs in real code
+                             ((if c
+                                  (dynamic-require 'racket/pretty 'pretty-write)
+                                  (dynamic-require 'racket/pretty 'pretty-print))
+                              a b)))
          #:transparent)]))
 
 
@@ -178,8 +184,16 @@ at least theoretically.
          cond-contracted
          define-struct/cond-contract
          define/cond-contract
+         contract-req
          define/cond-contract/provide)
 
+(define-require-syntax contract-req
+  (if enable-contracts?
+      (syntax-rules ()
+        [(_) racket/contract])
+      (syntax-rules ()
+        [(_) (combine-in)])))
+
 (define-syntax-rule (define/cond-contract/provide (name . args) c . body)
   (begin (define/cond-contract name c
            (begin
diff --git a/collects/typed-scheme/lang/reader.rkt b/collects/typed-scheme/lang/reader.rkt
index b00d3a3b75..928ebc4cb8 100644
--- a/collects/typed-scheme/lang/reader.rkt
+++ b/collects/typed-scheme/lang/reader.rkt
@@ -6,11 +6,11 @@ typed-scheme
 #:read-syntax r:read-syntax
 #:info make-info
 
-(require (prefix-in r: "../typed-reader.rkt"))
+(require (prefix-in r: typed-racket/typed-reader))
 
 (define (make-info key default use-default)
   (case key
     [(drscheme:toolbar-buttons)
-     (list (dynamic-require 'typed-scheme/optimizer/tool/tool
+     (list (dynamic-require 'typed-racket/optimizer/tool/tool
                             'performance-report-drracket-button))]
     [else (use-default key default)]))
diff --git a/collects/typed-scheme/main.rkt b/collects/typed-scheme/main.rkt
index 4e9ea23af1..295e469d89 100644
--- a/collects/typed-scheme/main.rkt
+++ b/collects/typed-scheme/main.rkt
@@ -1,5 +1,4 @@
-#lang racket/base
+#lang typed-racket/minimal
 
 (require typed/scheme/base)
 (provide (all-from-out typed/scheme/base))
-
diff --git a/collects/typed-scheme/no-check.rkt b/collects/typed-scheme/no-check.rkt
index 1d0f8486f4..52647ae4a1 100644
--- a/collects/typed-scheme/no-check.rkt
+++ b/collects/typed-scheme/no-check.rkt
@@ -1,13 +1,14 @@
 #lang scheme/base
 
 (require
- (except-in "base-env/prims.rkt"
+ (except-in typed-racket/base-env/prims
             require/typed require/opaque-type require-typed-struct)
- "base-env/base-types-extra.rkt"
+ typed-racket/base-env/base-types-extra
  (for-syntax scheme/base syntax/parse syntax/struct))
 (provide (all-from-out scheme/base)
 	 (all-defined-out)
-	 (all-from-out "base-env/prims.rkt" "base-env/base-types-extra.rkt"))
+	 (all-from-out typed-racket/base-env/prims 
+                       typed-racket/base-env/base-types-extra))
 
 
 (define-syntax (require/typed stx)
diff --git a/collects/typed-scheme/no-check/lang/reader.rkt b/collects/typed-scheme/no-check/lang/reader.rkt
index 9448bbaf5b..744ec50d0c 100644
--- a/collects/typed-scheme/no-check/lang/reader.rkt
+++ b/collects/typed-scheme/no-check/lang/reader.rkt
@@ -5,4 +5,4 @@ typed-scheme/no-check
 #:read r:read
 #:read-syntax r:read-syntax
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed-scheme/utils/unit-utils.rkt b/collects/typed-scheme/utils/unit-utils.rkt
deleted file mode 100644
index f4f5c11b62..0000000000
--- a/collects/typed-scheme/utils/unit-utils.rkt
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang scheme/base
-
-
-
diff --git a/collects/typed/file/gif.rkt b/collects/typed/file/gif.rkt
index 6f96c976d8..1c18644afe 100644
--- a/collects/typed/file/gif.rkt
+++ b/collects/typed/file/gif.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/file/md5.rkt b/collects/typed/file/md5.rkt
index 0cab46d7ba..44ca600b78 100644
--- a/collects/typed/file/md5.rkt
+++ b/collects/typed/file/md5.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 (require/typed file/md5
                [md5 ((U Bytes Input-Port) -> Bytes)])
 (provide md5)
diff --git a/collects/typed/file/tar.rkt b/collects/typed/file/tar.rkt
index 0497d8c9fc..4d34a624b5 100644
--- a/collects/typed/file/tar.rkt
+++ b/collects/typed/file/tar.rkt
@@ -1,5 +1,5 @@
-#lang typed-scheme
-;; typed-scheme wrapper on file/tar
+#lang typed/racket/base
+;; typed-racket wrapper on file/tar
 ;; yc 2009/2/25
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/collects/typed/framework/framework.rkt b/collects/typed/framework/framework.rkt
index 23f267e67b..84094c24e5 100644
--- a/collects/typed/framework/framework.rkt
+++ b/collects/typed/framework/framework.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils typed/mred/mred)
 
diff --git a/collects/typed/net/base64.rkt b/collects/typed/net/base64.rkt
index 0745794516..10f4392fdb 100644
--- a/collects/typed/net/base64.rkt
+++ b/collects/typed/net/base64.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/cgi.rkt b/collects/typed/net/cgi.rkt
index 80c3b0de55..364a4325c3 100644
--- a/collects/typed/net/cgi.rkt
+++ b/collects/typed/net/cgi.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/cookie.rkt b/collects/typed/net/cookie.rkt
index 3eb8092adf..bf78fc0000 100644
--- a/collects/typed/net/cookie.rkt
+++ b/collects/typed/net/cookie.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/dns.rkt b/collects/typed/net/dns.rkt
index 24ef679f81..db33203cad 100644
--- a/collects/typed/net/dns.rkt
+++ b/collects/typed/net/dns.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
@@ -7,4 +7,3 @@
   [dns-get-name (String String -> String)]
   [dns-get-mail-exchanger (String String -> String )]
   [dns-find-nameserver (-> (Option String))])
-
diff --git a/collects/typed/net/ftp.rkt b/collects/typed/net/ftp.rkt
index 041befc0d5..3299ab67e8 100644
--- a/collects/typed/net/ftp.rkt
+++ b/collects/typed/net/ftp.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/gifwrite.rkt b/collects/typed/net/gifwrite.rkt
index cfe9167c5b..a2e550b734 100644
--- a/collects/typed/net/gifwrite.rkt
+++ b/collects/typed/net/gifwrite.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/file/gif)
 (provide (all-from-out typed/file/gif))
diff --git a/collects/typed/net/head.rkt b/collects/typed/net/head.rkt
index ec6493dc69..66c7530bee 100644
--- a/collects/typed/net/head.rkt
+++ b/collects/typed/net/head.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/imap.rkt b/collects/typed/net/imap.rkt
index 0e347e4082..ce2bd631dc 100644
--- a/collects/typed/net/imap.rkt
+++ b/collects/typed/net/imap.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/mime.rkt b/collects/typed/net/mime.rkt
index 82893b26e5..f65294e99c 100644
--- a/collects/typed/net/mime.rkt
+++ b/collects/typed/net/mime.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 ;; -- basic mime structures --
diff --git a/collects/typed/net/nntp.rkt b/collects/typed/net/nntp.rkt
index f2310c9350..cb540e0ac9 100644
--- a/collects/typed/net/nntp.rkt
+++ b/collects/typed/net/nntp.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/pop3.rkt b/collects/typed/net/pop3.rkt
index 395b3a7be7..0190ceef9e 100644
--- a/collects/typed/net/pop3.rkt
+++ b/collects/typed/net/pop3.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/qp.rkt b/collects/typed/net/qp.rkt
index 9d0344a2e5..814161cac7 100644
--- a/collects/typed/net/qp.rkt
+++ b/collects/typed/net/qp.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/sendmail.rkt b/collects/typed/net/sendmail.rkt
index 113dc250d4..958d75df1a 100644
--- a/collects/typed/net/sendmail.rkt
+++ b/collects/typed/net/sendmail.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/sendurl.rkt b/collects/typed/net/sendurl.rkt
index 2be923fc7b..84d90af1e7 100644
--- a/collects/typed/net/sendurl.rkt
+++ b/collects/typed/net/sendurl.rkt
@@ -1,8 +1,8 @@
-#lang typed-scheme
+#lang typed/racket/base
 (require/typed net/sendurl
-	       [send-url (String -> Void)]
-	       [unix-browser-list (Listof Symbol)]
-	       [browser-preference? (String -> Boolean)]
-	       [external-browser  (-> (U Symbol #f (Pair String String)))])
+               [send-url (String -> Void)]
+               [unix-browser-list (Listof Symbol)]
+               [browser-preference? (String -> Boolean)]
+               [external-browser  (-> (U Symbol #f (Pair String String)))])
 
 (provide send-url unix-browser-list browser-preference? external-browser)
diff --git a/collects/typed/net/smtp.rkt b/collects/typed/net/smtp.rkt
index 78b02ff651..18791c9847 100644
--- a/collects/typed/net/smtp.rkt
+++ b/collects/typed/net/smtp.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/uri-codec.rkt b/collects/typed/net/uri-codec.rkt
index 2089712c26..ed89cf33ec 100644
--- a/collects/typed/net/uri-codec.rkt
+++ b/collects/typed/net/uri-codec.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/net/url.rkt b/collects/typed/net/url.rkt
index 20b4196e08..f435cb0f3e 100644
--- a/collects/typed/net/url.rkt
+++ b/collects/typed/net/url.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (require typed/private/utils)
 
diff --git a/collects/typed/private/utils.rkt b/collects/typed/private/utils.rkt
index 5abf5a87f2..46ef552449 100644
--- a/collects/typed/private/utils.rkt
+++ b/collects/typed/private/utils.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 
 (define-syntax-rule (dt nm t)
   (begin (define-type-alias nm t) (provide nm)))
diff --git a/collects/typed/racket.rkt b/collects/typed/racket.rkt
index 99d54c6855..85047c7bff 100644
--- a/collects/typed/racket.rkt
+++ b/collects/typed/racket.rkt
@@ -1,4 +1,4 @@
-#lang racket/base
+#lang typed-racket/minimal
 
 (require typed/racket/base racket/require (subtract-in racket typed/racket/base racket/contract)
 	 (for-syntax racket/base))
diff --git a/collects/typed/racket/base.rkt b/collects/typed/racket/base.rkt
index c3a319cdb0..860ebfa9ac 100644
--- a/collects/typed/racket/base.rkt
+++ b/collects/typed/racket/base.rkt
@@ -1,18 +1,18 @@
-#lang s-exp typed-scheme/minimal
+#lang typed-racket/minimal
 
 (providing (libs (except racket/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct for for*))
 	   (basics #%module-begin #%top-interaction lambda #%app))
 
-(require typed-scheme/base-env/extra-procs
-         (except-in typed-scheme/base-env/prims
+(require typed-racket/base-env/extra-procs
+         (except-in typed-racket/base-env/prims
            require-typed-struct-legacy
            require/typed-legacy)
-         typed-scheme/base-env/base-types
-         typed-scheme/base-env/base-types-extra
-	 (for-syntax typed-scheme/base-env/base-types-extra))
+         typed-racket/base-env/base-types
+         typed-racket/base-env/base-types-extra
+	 (for-syntax typed-racket/base-env/base-types-extra))
 (provide (rename-out [define-type-alias define-type])
-         (all-from-out typed-scheme/base-env/prims)
-         (all-from-out typed-scheme/base-env/base-types)
-         (all-from-out typed-scheme/base-env/base-types-extra)
+         (all-from-out typed-racket/base-env/prims)
+         (all-from-out typed-racket/base-env/base-types)
+         (all-from-out typed-racket/base-env/base-types-extra)
 	 assert defined? with-type for for*
-         (for-syntax (all-from-out typed-scheme/base-env/base-types-extra)))
+         (for-syntax (all-from-out typed-racket/base-env/base-types-extra)))
diff --git a/collects/typed/racket/base/lang/reader.rkt b/collects/typed/racket/base/lang/reader.rkt
index 956259de88..849ff945b1 100644
--- a/collects/typed/racket/base/lang/reader.rkt
+++ b/collects/typed/racket/base/lang/reader.rkt
@@ -12,7 +12,7 @@ typed/racket/base
     [else (use-default key default)]))
 
 (define make-language-info
-  `#(typed-scheme/language-info get-info ()))
+  `#(typed-racket/language-info get-info ()))
 
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/racket/base/no-check.rkt b/collects/typed/racket/base/no-check.rkt
index a5be88a158..4508a415b6 100644
--- a/collects/typed/racket/base/no-check.rkt
+++ b/collects/typed/racket/base/no-check.rkt
@@ -1,4 +1,4 @@
-#lang racket/base
+#lang typed-racket/minimal
 
 (require racket/require typed-scheme/no-check (subtract-in typed/racket/base typed-scheme/no-check))
 (provide (all-from-out typed/racket/base typed-scheme/no-check))
diff --git a/collects/typed/racket/base/no-check/lang/reader.rkt b/collects/typed/racket/base/no-check/lang/reader.rkt
index af4b238de8..4af7c2e3be 100644
--- a/collects/typed/racket/base/no-check/lang/reader.rkt
+++ b/collects/typed/racket/base/no-check/lang/reader.rkt
@@ -5,4 +5,4 @@ typed/racket/base/no-check
 #:read r:read
 #:read-syntax r:read-syntax
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/racket/lang/reader.rkt b/collects/typed/racket/lang/reader.rkt
index bce2cd00e8..456c2a6340 100644
--- a/collects/typed/racket/lang/reader.rkt
+++ b/collects/typed/racket/lang/reader.rkt
@@ -10,12 +10,12 @@ typed/racket
 (define (make-info key default use-default)
   (case key
     [(drscheme:toolbar-buttons)
-     (list (dynamic-require 'typed-scheme/optimizer/tool/tool
+     (list (dynamic-require 'typed-racket/optimizer/tool/tool
                             'performance-report-drracket-button))]
     [else (use-default key default)]))
 
 (define make-language-info
-  `#(typed-scheme/language-info get-info ()))
+  `#(typed-racket/language-info get-info ()))
 
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/racket/no-check.rkt b/collects/typed/racket/no-check.rkt
index f4ee4b0923..5dec3f1a25 100644
--- a/collects/typed/racket/no-check.rkt
+++ b/collects/typed/racket/no-check.rkt
@@ -1,4 +1,4 @@
-#lang racket/base
+#lang typed-racket/minimal
 
 (require racket/require typed-scheme/no-check (subtract-in typed/racket typed-scheme/no-check))
 (provide (all-from-out typed/racket typed-scheme/no-check))
diff --git a/collects/typed/racket/no-check/lang/reader.rkt b/collects/typed/racket/no-check/lang/reader.rkt
index 7d16e8048a..0f9a2271b8 100644
--- a/collects/typed/racket/no-check/lang/reader.rkt
+++ b/collects/typed/racket/no-check/lang/reader.rkt
@@ -5,4 +5,4 @@ typed/racket/no-check
 #:read r:read
 #:read-syntax r:read-syntax
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/rackunit/type-env-ext.rkt b/collects/typed/rackunit/type-env-ext.rkt
index c73b6b4cd0..e65f6a8974 100644
--- a/collects/typed/rackunit/type-env-ext.rkt
+++ b/collects/typed/rackunit/type-env-ext.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require typed-scheme/utils/utils
+(require typed-racket/utils/utils
          (prefix-in ru: (combine-in rackunit rackunit/private/test-case rackunit/private/check))
          (for-syntax
           scheme/base syntax/parse
diff --git a/collects/typed/scheme.rkt b/collects/typed/scheme.rkt
index 39e626df29..b300589a39 100644
--- a/collects/typed/scheme.rkt
+++ b/collects/typed/scheme.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang typed-racket/minimal
 
 (require typed/scheme/base scheme/require (subtract-in scheme typed/scheme/base scheme/contract)
 	 (for-syntax scheme/base))
diff --git a/collects/typed/scheme/base.rkt b/collects/typed/scheme/base.rkt
index 6949b79a7d..6dd51f2f5b 100644
--- a/collects/typed/scheme/base.rkt
+++ b/collects/typed/scheme/base.rkt
@@ -1,21 +1,21 @@
-#lang s-exp typed-scheme/minimal
+#lang typed-racket/minimal
 
 (providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct for for*))
 	   (basics #%module-begin #%top-interaction lambda #%app))
 
-(require typed-scheme/base-env/extra-procs
+(require typed-racket/base-env/extra-procs
          (rename-in
-           (except-in typed-scheme/base-env/prims
+           (except-in typed-racket/base-env/prims
              require-typed-struct
              require/typed)
            (require-typed-struct-legacy require-typed-struct)
            (require/typed-legacy require/typed))
-         typed-scheme/base-env/base-types
-         typed-scheme/base-env/base-types-extra
-	 (for-syntax typed-scheme/base-env/base-types-extra))
+         typed-racket/base-env/base-types
+         typed-racket/base-env/base-types-extra
+	 (for-syntax typed-racket/base-env/base-types-extra))
 (provide (rename-out [define-type-alias define-type])
-         (all-from-out typed-scheme/base-env/prims)
-         (all-from-out typed-scheme/base-env/base-types)
-         (all-from-out typed-scheme/base-env/base-types-extra)
+         (all-from-out typed-racket/base-env/prims)
+         (all-from-out typed-racket/base-env/base-types)
+         (all-from-out typed-racket/base-env/base-types-extra)
 	 assert defined? with-type for for*
-         (for-syntax (all-from-out typed-scheme/base-env/base-types-extra)))
+         (for-syntax (all-from-out typed-racket/base-env/base-types-extra)))
diff --git a/collects/typed/scheme/base/lang/reader.rkt b/collects/typed/scheme/base/lang/reader.rkt
index b098289086..6da86b0d5f 100644
--- a/collects/typed/scheme/base/lang/reader.rkt
+++ b/collects/typed/scheme/base/lang/reader.rkt
@@ -12,7 +12,7 @@ typed/scheme/base
     [else (use-default key default)]))
 
 (define make-language-info
-  `#(typed-scheme/language-info get-info ()))
+  `#(typed-racket/language-info get-info ()))
 
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/scheme/base/no-check.rkt b/collects/typed/scheme/base/no-check.rkt
new file mode 100644
index 0000000000..d8d95d096f
--- /dev/null
+++ b/collects/typed/scheme/base/no-check.rkt
@@ -0,0 +1,4 @@
+#lang typed-racket/minimal
+
+(require racket/require typed-scheme/no-check (subtract-in typed/scheme/base typed-scheme/no-check))
+(provide (all-from-out typed/scheme/base typed-scheme/no-check))
diff --git a/collects/typed/scheme/base/no-check/lang/reader.rkt b/collects/typed/scheme/base/no-check/lang/reader.rkt
new file mode 100644
index 0000000000..579a3f8f20
--- /dev/null
+++ b/collects/typed/scheme/base/no-check/lang/reader.rkt
@@ -0,0 +1,8 @@
+#lang s-exp syntax/module-reader
+
+typed/scheme/base/no-check
+
+#:read r:read
+#:read-syntax r:read-syntax
+
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/scheme/lang/reader.rkt b/collects/typed/scheme/lang/reader.rkt
index 16197bc2a2..be96569bf3 100644
--- a/collects/typed/scheme/lang/reader.rkt
+++ b/collects/typed/scheme/lang/reader.rkt
@@ -10,12 +10,12 @@ typed/scheme
 (define (make-info key default use-default)
   (case key
     [(drscheme:toolbar-buttons)
-     (list (dynamic-require 'typed-scheme/optimizer/tool/tool
+     (list (dynamic-require 'typed-racket/optimizer/tool/tool
                             'performance-report-drracket-button))]
     [else (use-default key default)]))
 
 (define make-language-info
-  `#(typed-scheme/language-info get-info ()))
+  `#(typed-racket/language-info get-info ()))
 
 
-(require (prefix-in r: typed-scheme/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/scheme/no-check.rkt b/collects/typed/scheme/no-check.rkt
new file mode 100644
index 0000000000..0f74ed198e
--- /dev/null
+++ b/collects/typed/scheme/no-check.rkt
@@ -0,0 +1,4 @@
+#lang typed-racket/minimal
+
+(require racket/require typed-scheme/no-check (subtract-in typed/scheme typed-scheme/no-check))
+(provide (all-from-out typed/scheme typed-scheme/no-check))
diff --git a/collects/typed/scheme/no-check/lang/reader.rkt b/collects/typed/scheme/no-check/lang/reader.rkt
new file mode 100644
index 0000000000..1084e9350a
--- /dev/null
+++ b/collects/typed/scheme/no-check/lang/reader.rkt
@@ -0,0 +1,8 @@
+#lang s-exp syntax/module-reader
+
+typed/scheme/no-check
+
+#:read r:read
+#:read-syntax r:read-syntax
+
+(require (prefix-in r: typed-racket/typed-reader))
diff --git a/collects/typed/srfi/14.rkt b/collects/typed/srfi/14.rkt
index 70b2866fb6..44e9f2c74b 100644
--- a/collects/typed/srfi/14.rkt
+++ b/collects/typed/srfi/14.rkt
@@ -1,4 +1,4 @@
-#lang typed-scheme
+#lang typed/racket/base
 (require/opaque-type Char-Set char-set? srfi/14)
 
 (define-type-alias Cursor (Pair 0 (Listof (Pair Integer Integer))))
diff --git a/collects/typed/test-engine/type-env-ext.rkt b/collects/typed/test-engine/type-env-ext.rkt
index cff027a220..213468444a 100644
--- a/collects/typed/test-engine/type-env-ext.rkt
+++ b/collects/typed/test-engine/type-env-ext.rkt
@@ -1,9 +1,9 @@
-#lang scheme/base
+#lang racket/base
 
-(require typed-scheme/utils/utils
+(require typed-racket/utils/utils
          (prefix-in ce: test-engine/racket-tests)
          (for-syntax
-          scheme/base syntax/parse
+          racket/base syntax/parse
           (utils tc-utils)
           (env init-envs)
           (except-in (rep filter-rep object-rep type-rep) make-arr)
diff --git a/collects/unstable/lazy-require.rkt b/collects/unstable/lazy-require.rkt
new file mode 100644
index 0000000000..e33b7cbd96
--- /dev/null
+++ b/collects/unstable/lazy-require.rkt
@@ -0,0 +1,37 @@
+#lang racket/base
+(require (for-syntax racket/base)
+         racket/runtime-path
+         racket/promise)
+(provide lazy-require
+         (for-syntax #%datum))
+
+(define-syntax (lazy-require stx)
+  (syntax-case stx ()
+    [(lazy-require [modpath (thing ...)] ...)
+     #`(begin (define-namespace-anchor anchor)
+              (lazy-require1 modpath (thing ...) anchor #,stx)
+              ...)]))
+
+(define-syntax (lazy-require1 stx)
+  (syntax-case stx ()
+    [(lazy-require1 modpath (name ...) anchor orig-stx)
+     (with-syntax ([(defn ...)
+                    (for/list ([name (in-list (syntax->list #'(name ...)))])
+                      (unless (identifier? name)
+                        (raise-syntax-error #f "expected identifier" #'orig-stx name))
+                      #`(define #,name (make-lazy-function '#,name get-sym)))])
+       #'(begin (define-runtime-module-path-index mpi-var modpath)
+                (define (get-sym sym)
+                  (parameterize ((current-namespace (namespace-anchor->namespace anchor)))
+                    (dynamic-require mpi-var sym)))
+                defn ...))]))
+
+(define (make-lazy-function name get-sym)
+  ;; Use 'delay/sync' because 'delay' promise is not reentrant.
+  ;; FIXME: OTOH, 'delay/sync' promise is not kill-safe.
+  (let ([fun-p (delay/sync (get-sym name))])
+    (procedure-rename
+     (make-keyword-procedure
+      (lambda (kws kwargs . args)
+        (keyword-apply (force fun-p) kws kwargs args)))
+     name)))
diff --git a/collects/unstable/scribblings/lazy-require.scrbl b/collects/unstable/scribblings/lazy-require.scrbl
new file mode 100644
index 0000000000..a7453c8dc6
--- /dev/null
+++ b/collects/unstable/scribblings/lazy-require.scrbl
@@ -0,0 +1,24 @@
+#lang scribble/manual
+@(require scribble/eval
+          "utils.rkt"
+          (for-label racket/base
+                     racket/runtime-path
+                     unstable/lazy-require))
+
+@title[#:tag "lazy-require"]{Lazy Require}
+
+@defmodule[unstable/lazy-require]
+
+@unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
+
+@defform[(lazy-require [mod-expr (imported-fun-id ...)] ...)
+         #:contracts ([mod-expr module-path?])]{
+
+Defines each @racket[imported-fun-id] as a function that, when called,
+dynamically requires the export named @racket['imported-fun-id] from
+the module specified by @racket[mod-expr] and calls it with the same
+arguments.
+                                                
+As with @racket[define-runtime-module-path-index], @racket[mod-expr]
+is evaluated both in phase 0 and phase 1.
+}
diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl
index 3c72f03fbf..61ca638b48 100644
--- a/collects/unstable/scribblings/unstable.scrbl
+++ b/collects/unstable/scribblings/unstable.scrbl
@@ -88,6 +88,7 @@ Keep documentation and tests up to date.
 @include-section["generics.scrbl"]
 @include-section["hash.scrbl"]
 @include-section["class-iop.scrbl"] ;; Interface-oriented Programming
+@include-section["lazy-require.scrbl"]
 @include-section["list.scrbl"]
 @include-section["logging.scrbl"]
 @include-section["markparam.scrbl"]
diff --git a/collects/web-server/dispatchers/dispatch-files.rkt b/collects/web-server/dispatchers/dispatch-files.rkt
index 037f311647..72297496a9 100644
--- a/collects/web-server/dispatchers/dispatch-files.rkt
+++ b/collects/web-server/dispatchers/dispatch-files.rkt
@@ -14,7 +14,7 @@
  [read-range-header (-> (listof header?) (or/c (listof pair?) false/c))]
  [make
   (->* (#:url->path url->path/c)
-       (#:path->mime-type (path-string? . -> . bytes?)
+       (#:path->mime-type (path-string? . -> . (or/c false/c bytes?))
                           #:indices (listof path-string?))
        dispatcher/c)])
 
@@ -27,7 +27,7 @@
 (define interface-version 'v1)
 
 (define (make #:url->path url->path
-              #:path->mime-type [path->mime-type (lambda (path) TEXT/HTML-MIME-TYPE)]
+              #:path->mime-type [path->mime-type (lambda (path) #f)]
               #:indices [indices (list "index.html" "index.htm")])
   (lambda (conn req)
     (define uri (request-uri req))
diff --git a/collects/web-server/http/response-structs.rkt b/collects/web-server/http/response-structs.rkt
index 49748c9db8..3f63724828 100644
--- a/collects/web-server/http/response-structs.rkt
+++ b/collects/web-server/http/response-structs.rkt
@@ -24,8 +24,8 @@
          ([code number?]
           [message bytes?]
           [seconds number?]
-          [mime bytes?]
+          [mime (or/c false/c bytes?)]
           [headers (listof header?)]
           [output (output-port? . -> . void)])]
- [response/full (-> number? bytes? number? bytes? (listof header?) (listof bytes?) response?)]
+ [response/full (-> number? bytes? number? (or/c false/c bytes?) (listof header?) (listof bytes?) response?)]
  [TEXT/HTML-MIME-TYPE bytes?])
diff --git a/collects/web-server/http/response.rkt b/collects/web-server/http/response.rkt
index 6e4ee7e1b3..f64c629b0c 100644
--- a/collects/web-server/http/response.rkt
+++ b/collects/web-server/http/response.rkt
@@ -16,7 +16,7 @@
  [print-headers (output-port? (listof header?) . -> . void)]
  [rename ext:output-response output-response (connection? response? . -> . void)]
  [rename ext:output-response/method output-response/method (connection? response? bytes? . -> . void)]
- [rename ext:output-file output-file (connection? path-string? bytes? bytes? (or/c pair? false/c) . -> . void)])
+ [rename ext:output-file output-file (connection? path-string? bytes? (or/c bytes? false/c) (or/c pair? false/c) . -> . void)])
 
 (define (output-response conn resp)
   (output-response/method conn resp #"GET"))
@@ -32,37 +32,46 @@
 ;; Write the headers portion of a response to an output port.
 ;; NOTE: According to RFC 2145 the server should write HTTP/1.1
 ;;       header for *all* clients.
-(define-syntax-rule (maybe-hash-set! h k v)
-  (unless (hash-has-key? h k)
-    (hash-set! h k (header k v))))
-(define-syntax-rule (maybe-hash-set!* h [k v] ...)
-  (begin (maybe-hash-set! h k v)
-         ...))
+(define-syntax-rule (maybe-header h k v)
+  (if (hash-has-key? h k)
+    empty
+    (list (header k v))))
+(define-syntax-rule (maybe-headers h [k v] ...)
+  (append (maybe-header h k v)
+          ...))
 
 (define (output-response-head conn bresp)
   (fprintf (connection-o-port conn)
            "HTTP/1.1 ~a ~a\r\n"
            (response-code bresp)
            (response-message bresp))
-  (define hs (make-hash))
-  (for ([h (in-list (response-headers bresp))])
-    (hash-set! hs (header-field h) h))
-  (maybe-hash-set!*
-   hs
-   [#"Date" 
-    (string->bytes/utf-8 (seconds->gmt-string (current-seconds)))]
-   [#"Last-Modified"
-    (string->bytes/utf-8 (seconds->gmt-string (response-seconds bresp)))]
-   [#"Server"
-    #"Racket"]
-   [#"Content-Type"
-    (response-mime bresp)])
-  (when (connection-close? conn)
-    (hash-set! hs #"Connection"
-               (make-header #"Connection" #"close")))
+  (define hs (response-headers bresp))
+  (define seen? (make-hash))
+  (for ([h (in-list hs)])
+    (hash-set! seen? (header-field h) #t))
   (output-headers
-   conn 
-   (hash-values hs)))
+   conn
+   (append
+    (maybe-headers
+     seen?
+     [#"Date" 
+      (string->bytes/utf-8 (seconds->gmt-string (current-seconds)))]
+     [#"Last-Modified"
+      (string->bytes/utf-8 (seconds->gmt-string (response-seconds bresp)))]
+     [#"Server"
+      #"Racket"])
+    (if (response-mime bresp)
+        (maybe-headers
+         seen?
+         [#"Content-Type"
+          (response-mime bresp)])
+        empty)
+    (if (connection-close? conn)
+        (maybe-headers
+         seen?
+         [#"Connection" #"close"])
+        empty)
+    hs)))
 
 ;; output-headers : connection (list-of header) -> void
 (define (output-headers conn headers)
@@ -147,12 +156,12 @@
 ;; A boundary is generated only if a multipart/byteranges response needs
 ;; to be generated (i.e. if a Ranges header was specified with more than
 ;; one range in it).
-(define (output-file conn file-path method mime-type ranges)
+(define (output-file conn file-path method maybe-mime-type ranges)
   (output-file/boundary
    conn
    file-path
    method
-   mime-type
+   maybe-mime-type
    ranges
    (if (and ranges (> (length ranges) 1))
        (md5 (string->bytes/utf-8 (number->string (current-inexact-milliseconds))))
@@ -165,7 +174,7 @@
 ;;              (U (listof (U byte-range-spec suffix-byte-range-spec)) #f)
 ;;              (U bytes #f)
 ;;           -> void
-(define (output-file/boundary conn file-path method mime-type ranges boundary)
+(define (output-file/boundary conn file-path method maybe-mime-type ranges boundary)
   ; total-file-length : integer
   (define total-file-length
     (file-size file-path))
@@ -184,7 +193,7 @@
                               (exn-message exn))
                      (output-response-head
                       conn
-                      (make-416-response modified-seconds mime-type)))])
+                      (make-416-response modified-seconds maybe-mime-type)))])
     (let* (; converted-ranges : (alist-of integer integer)
            ; This is a list of actual start and end offsets in the file. 
            ; See the comments for convert-http-ranges for more information.
@@ -198,7 +207,7 @@
            ; response. This *must be* the same length as converted-ranges.
            [multipart-headers
             (if (> (length converted-ranges) 1)
-                (prerender-multipart/byteranges-headers mime-type converted-ranges total-file-length)
+                (prerender-multipart/byteranges-headers maybe-mime-type converted-ranges total-file-length)
                 (list #""))]
            ; total-content-length : integer
            [total-content-length
@@ -221,8 +230,8 @@
       (output-response-head
        conn
        (if ranges
-           (make-206-response modified-seconds mime-type total-content-length total-file-length converted-ranges boundary)
-           (make-200-response modified-seconds mime-type total-content-length)))
+           (make-206-response modified-seconds maybe-mime-type total-content-length total-file-length converted-ranges boundary)
+           (make-200-response modified-seconds maybe-mime-type total-content-length)))
       ; Send the appropriate file content:
       (when (bytes-ci=? method #"GET")
         (adjust-connection-timeout! ; Give it one second per byte.
@@ -256,13 +265,14 @@
                        (loop rest (cdr multipart-headers))]))))))))))
 
 ;; prerender-multipart/byteranges-headers : bytes (alist-of integer integer) integer -> (list-of bytes)
-(define (prerender-multipart/byteranges-headers mime-type converted-ranges total-file-length)
+(define (prerender-multipart/byteranges-headers maybe-mime-type converted-ranges total-file-length)
   (map (lambda (range)
          (match range
            [(list-rest start end)
             (let ([out (open-output-bytes)])
-              (print-headers out (list (make-header #"Content-Type" mime-type)
-                                       (make-content-range-header start end total-file-length)))
+              (when maybe-mime-type
+                (print-headers out (list (make-header #"Content-Type" maybe-mime-type))))
+              (print-headers out (list (make-content-range-header start end total-file-length)))
               (begin0 (get-output-bytes out)
                       (close-output-port out)))]))
        converted-ranges))
@@ -321,14 +331,14 @@
       converted))
 
 ;; make-206-response : integer bytes integer integer (alist-of integer integer) bytes -> basic-response
-(define (make-206-response modified-seconds mime-type total-content-length total-file-length converted-ranges boundary)
+(define (make-206-response modified-seconds maybe-mime-type total-content-length total-file-length converted-ranges boundary)
   (if (= (length converted-ranges) 1)
       (let ([start (caar converted-ranges)]
             [end   (cdar converted-ranges)])
         (response
          206 #"Partial content"
          modified-seconds
-         mime-type 
+         maybe-mime-type 
          (list (make-header #"Accept-Ranges" #"bytes")
                (make-content-length-header total-content-length)
                (make-content-range-header start end total-file-length))
@@ -342,21 +352,21 @@
        void)))
 
 ;; make-200-response : integer bytes integer -> basic-response
-(define (make-200-response modified-seconds mime-type total-content-length)
+(define (make-200-response modified-seconds maybe-mime-type total-content-length)
   (response
    200 #"OK"
    modified-seconds
-   mime-type 
+   maybe-mime-type 
    (list (make-header #"Accept-Ranges" #"bytes")
          (make-content-length-header total-content-length))
    void))
 
 ;; make-416-response : integer bytes -> basic-response
-(define (make-416-response modified-seconds mime-type)
+(define (make-416-response modified-seconds maybe-mime-type)
   (response
    416 #"Invalid range request"
    modified-seconds
-   mime-type 
+   maybe-mime-type 
    null
    void))
 
diff --git a/collects/web-server/http/xexpr.rkt b/collects/web-server/http/xexpr.rkt
index 708066461d..298be367f8 100644
--- a/collects/web-server/http/xexpr.rkt
+++ b/collects/web-server/http/xexpr.rkt
@@ -28,5 +28,5 @@
 (provide/contract
  [response/xexpr 
   ((pretty-xexpr/c)
-   (#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:cookies (listof cookie?) #:headers (listof header?) #:preamble bytes?)
+   (#:code number? #:message bytes? #:seconds number? #:mime-type (or/c false/c bytes?) #:cookies (listof cookie?) #:headers (listof header?) #:preamble bytes?)
    . ->* . response?)])
diff --git a/collects/web-server/private/mime-types.rkt b/collects/web-server/private/mime-types.rkt
index 1a7346f709..3f48b5ab77 100644
--- a/collects/web-server/private/mime-types.rkt
+++ b/collects/web-server/private/mime-types.rkt
@@ -6,7 +6,7 @@
          web-server/http)
 (provide/contract
  [read-mime-types (path-string? . -> . (hash/c symbol? bytes?))]
- [make-path->mime-type (path-string? . -> . (path? . -> . bytes?))])
+ [make-path->mime-type (path-string? . -> . (path? . -> . (or/c false/c bytes?)))])
 
 ; read-mime-types : path? -> hash-table?
 (define (read-mime-types a-path)
@@ -40,5 +40,5 @@
       [(regexp #rx#".*\\.([^\\.]*$)" (list _ sffx))
        (hash-ref (force MIME-TYPE-TABLE)
                  (lowercase-symbol! sffx)
-                 TEXT/HTML-MIME-TYPE)]
-      [_ TEXT/HTML-MIME-TYPE])))
+                 #f)]
+      [_ #f])))
diff --git a/collects/web-server/scribblings/dispatchers.scrbl b/collects/web-server/scribblings/dispatchers.scrbl
index 5d0fa65e89..6d228e8ab7 100644
--- a/collects/web-server/scribblings/dispatchers.scrbl
+++ b/collects/web-server/scribblings/dispatchers.scrbl
@@ -316,7 +316,7 @@ a URL that refreshes the password file, servlet cache, etc.}
                 It defines a dispatcher construction procedure.}]{
 
 @defproc[(make [#:url->path url->path url->path/c]
-               [#:path->mime-type path->mime-type (path? . -> . bytes?) (lambda (path) TEXT/HTML-MIME-TYPE)]
+               [#:path->mime-type path->mime-type (path? . -> . (or/c false/c bytes)?) (lambda (path) #f)]
                [#:indices indices (listof string?) (list "index.html" "index.htm")])
          dispatcher/c]{
  Uses @racket[url->path] to extract a path from the URL in the request
diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl
index 299441b7e0..15b9c3b1b9 100644
--- a/collects/web-server/scribblings/http.scrbl
+++ b/collects/web-server/scribblings/http.scrbl
@@ -164,7 +164,7 @@ Here is an example typical of what you will find in many applications:
            ([code number?]
             [message bytes?]
             [seconds number?]
-            [mime bytes?]
+            [mime (or/c false/c bytes?)]
             [headers (listof header?)]
             [output (output-port? . -> . void)])]{
  An HTTP response where @racket[output] produces the body. @racket[code] is the response code,
@@ -182,7 +182,7 @@ Here is an example typical of what you will find in many applications:
  ]
 }
 
-@defproc[(response/full [code number?] [message bytes?] [seconds number?] [mime bytes?]
+@defproc[(response/full [code number?] [message bytes?] [seconds number?] [mime (or/c false/c bytes?)]
                         [headers (listof header?)] [body (listof bytes?)])
          response?]{
  A constructor for responses where @racket[body] is the response body.
@@ -481,7 +481,7 @@ web-server/insta
                          [#:code code number? 200]
                          [#:message message bytes? #"Okay"]
                          [#:seconds seconds number? (current-seconds)]
-                         [#:mime-type mime-type bytes? TEXT/HTML-MIME-TYPE]
+                         [#:mime-type mime-type (or/c false/c bytes?) TEXT/HTML-MIME-TYPE]
                          [#:headers headers (listof header?) empty]
                          [#:cookies cookies (listof cookie?) empty]
                          [#:preamble preamble bytes? #""])
diff --git a/collects/web-server/scribblings/mime-types.scrbl b/collects/web-server/scribblings/mime-types.scrbl
index 440d8f0288..0fd121d1cb 100644
--- a/collects/web-server/scribblings/mime-types.scrbl
+++ b/collects/web-server/scribblings/mime-types.scrbl
@@ -17,7 +17,7 @@ files.
 }
 
 @defproc[(make-path->mime-type [p path-string?])
-         (path? . -> . bytes?)]{
+         (path? . -> . (or/c false/c bytes?))]{
  Uses a @racket[read-mime-types] with @racket[p] and constructs a
  function from paths to their MIME type.
 }
diff --git a/collects/web-server/scribblings/web-server-unit.scrbl b/collects/web-server/scribblings/web-server-unit.scrbl
index c2e8b4df2f..d40e501ed9 100644
--- a/collects/web-server/scribblings/web-server-unit.scrbl
+++ b/collects/web-server/scribblings/web-server-unit.scrbl
@@ -47,7 +47,7 @@ operations:
  @item{Allows the @racket["/conf/refresh-passwords"] URL to refresh the password file.}
  @item{Allows the @racket["/conf/collect-garbage"] URL to call the garbage collector.}
  @item{Allows the @racket["/conf/refresh-servlets"] URL to refresh the servlets cache.}
- @item{Execute servlets in the mapping URLs to the given servlet root directory under htdocs.}
+ @item{Executes servlets mapping URLs to the given servlet root directory under htdocs.}
  @item{Serves files under the @racket["/"] URL in the given htdocs directory.}
 ]
 
diff --git a/doc/release-notes/drracket/HISTORY.txt b/doc/release-notes/drracket/HISTORY.txt
index 365603d657..31c6656f26 100644
--- a/doc/release-notes/drracket/HISTORY.txt
+++ b/doc/release-notes/drracket/HISTORY.txt
@@ -1,3 +1,50 @@
+------------------------------
+        Version 5.2
+------------------------------
+
+  . changed a three menu keybidings:
+      "New Tab" is now <menukey>-t
+      "Run" is now <menukey>-r
+      "Replace" is now <menukey>-shift-f
+
+    The preferences dialog (general tab) has a checkbox to
+    restore the old behavior.
+
+  . added online expansion and check syntax
+
+  . 2htdp/image: 
+     - shrunk the size of saved files that contain 2htdp/image bitmaps
+       (you can get these by copying and pasting from the REPL; using
+        "insert image" isn't affected)
+
+     - use the pre-multiplied alphas when doing image comparsion
+
+     - sped up rotation and flipping of bitmaps
+
+  . improved the way the scribble-language buttons (render html and
+    render pdf) work; they now basically do what 'Run' does, plus the
+    extra work of rendering the document; before they had their own error
+    handling and sandboxing code, which was less integrated with DrRacket
+
+  . improved the preference handling for the frame's location
+    (specifically for the multiple-monitors case)
+
+  . check syntax no longer turns the module in the #lang line red
+
+  . improved the handling of the 'Open Recent' menu item; specifically it
+    discards duplicates in a smarter way.
+
+  . adjust DrRacket to be more accomodating to hostile filesystems; specifically
+    it no longer fails if it cannot read the preference system and it no longer
+    writes anywhere to the filesystem during startup except the prefs (and if that
+    fails, it survives in a less annoying manner)
+
+  . DrRacket no longer locks the definitions text while evaluating the program
+    (it makes a copy of the definitions text and uses that copy now)
+
+  . cleaned up the Close/Close Window/Close Tab menu items to match
+    the platform-specific conventions
+
 ------------------------------
         Version 5.1.2
 ------------------------------
diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt
index 5828286a26..9f1649fb30 100644
--- a/doc/release-notes/racket/HISTORY.txt
+++ b/doc/release-notes/racket/HISTORY.txt
@@ -1,14 +1,36 @@
+Version 5.1.3.7
+Generalized begin-with-syntax to allow phase-N definitions,
+ both variable and syntax, within a module for all N >= 0;
+ removed define-values-for-syntax from fully expanded forms;
+ added begin-with-syntax to fully expanded forms
+Changed syntax-local-module-defined-identifiers to return
+ a table for all phases instead of just two values
+compiler/zo-structs: removed def-for-syntax, added
+ seq-for-syntax, changed some mod fields, added field to
+ def-syntaxes
+
 Version 5.1.3.4
 Add support for the collection links file, including
  (find-system-path 'links-file) and the raco link command
 
 Version 5.1.3.3
 unsafe/ffi: added support for C arrays and unions
+Fixed the planet module-name-resolver to be thread safe
+mrlib/include-bitmap: Adjust include-bitmap so it does not 
+ write to the filesystem
+framework: the finder get-file & put-file dialogs no 
+ longer normalize their results
+framework: added to the testing library so that tests can be
+ run when ignoring focus information from the underlying OS
 
 Version 5.1.2.3
 Added set-port-next-location! and changed the default prompt 
  read handler to use it when input and output ar terminals
 racket/gui: removed unsupported MDI styles and method
+compiler/cm: added support for using more powerful 
+ security-guards when writing to the filesystem
+Fixed an old bug so that planet now uses the already-downloaded 
+ .plt files (when present)
 
 Version 5.1.2.2
 Changed the location-creation semantics of internal definitions
diff --git a/doc/release-notes/typed-racket/HISTORY.txt b/doc/release-notes/typed-racket/HISTORY.txt
new file mode 100644
index 0000000000..015d098446
--- /dev/null
+++ b/doc/release-notes/typed-racket/HISTORY.txt
@@ -0,0 +1,4 @@
+5.1.3.*
+- Performance work: delayed environment evaluation
+- Support `racket'-style optional arguments
+- Changes to support new-style keyword argument expansion
diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c
index 53692af8ae..80f4ad7a13 100644
--- a/src/foreign/foreign.c
+++ b/src/foreign/foreign.c
@@ -2796,12 +2796,13 @@ void free_fficall_data(void *ignored, void *p)
   free(p);
 }
 
+static Scheme_Object *ffi_name_prefix = NULL;
+
 /* (ffi-call ffi-obj in-types out-type [abi save-errno? orig-place?]) -> (in-types -> out-value) */
 /* the real work is done by ffi_do_call above */
 #define MYNAME "ffi-call"
 static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
 {
-    static Scheme_Object *ffi_name_prefix = NULL;
     Scheme_Object *itypes = argv[1];
     Scheme_Object *otype  = argv[2];
     Scheme_Object *obj, *data, *p, *base;
@@ -2816,9 +2817,6 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
   #else
   # define FFI_CALL_VEC_SIZE 7
   #endif
-    MZ_REGISTER_STATIC(ffi_name_prefix);
-    if (!ffi_name_prefix)
-      ffi_name_prefix = scheme_make_byte_string_without_copying("ffi:");
     if (!SCHEME_FFIANYPTRP(argv[0]))
       scheme_wrong_type(MYNAME, "ffi-obj-or-cpointer", 0, argc, argv);
     obj = SCHEME_FFIANYPTR_VAL(argv[0]);
@@ -3403,6 +3401,9 @@ void scheme_init_foreign_globals()
   fail_ok_sym = scheme_intern_symbol("fail-ok");
   MZ_REGISTER_STATIC(abs_sym);
   abs_sym = scheme_intern_symbol("abs");
+
+  MZ_REGISTER_STATIC(ffi_name_prefix);
+  ffi_name_prefix = scheme_make_byte_string_without_copying("ffi:");
 }
 
 void scheme_init_foreign_places() {
diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc
index 0944b08e46..f59704d55c 100755
--- a/src/foreign/foreign.rktc
+++ b/src/foreign/foreign.rktc
@@ -2151,10 +2151,11 @@ void free_fficall_data(void *ignored, void *p)
   free(p);
 }
 
+static Scheme_Object *ffi_name_prefix = NULL;
+
 /* (ffi-call ffi-obj in-types out-type [abi save-errno? orig-place?]) -> (in-types -> out-value) */
 /* the real work is done by ffi_do_call above */
 @cdefine[ffi-call 3 6]{
-  static Scheme_Object *ffi_name_prefix = NULL;
   Scheme_Object *itypes = argv[1];
   Scheme_Object *otype  = argv[2];
   Scheme_Object *obj, *data, *p, *base;
@@ -2169,9 +2170,6 @@ void free_fficall_data(void *ignored, void *p)
 #else
 # define FFI_CALL_VEC_SIZE 7
 #endif
-  MZ_REGISTER_STATIC(ffi_name_prefix);
-  if (!ffi_name_prefix)
-    ffi_name_prefix = scheme_make_byte_string_without_copying("ffi:");
   if (!SCHEME_FFIANYPTRP(argv[0]))
     scheme_wrong_type(MYNAME, "ffi-obj-or-cpointer", 0, argc, argv);
   obj = SCHEME_FFIANYPTR_VAL(argv[0]);
@@ -2717,6 +2715,9 @@ void scheme_init_foreign_globals()
                @list{MZ_REGISTER_STATIC(@(cadr sym));
                      @(cadr sym) = scheme_intern_symbol("@(car sym)")})
              (reverse (symbols)))
+
+  MZ_REGISTER_STATIC(ffi_name_prefix);
+  ffi_name_prefix = scheme_make_byte_string_without_copying("ffi:");
 }
 
 void scheme_init_foreign_places() {
diff --git a/src/gracket/Makefile.in b/src/gracket/Makefile.in
index d39ef4d155..8ccc0b3d8d 100644
--- a/src/gracket/Makefile.in
+++ b/src/gracket/Makefile.in
@@ -217,7 +217,7 @@ install-wx_mac:
 install-wx_mac-cgc:
 	cd ..; $(ICP) -r gracket/GRacket@CGC@.app "$(prefix)/GRacket@CGC_CAP_INSTALLED@.app"
 	@RUN_RACKET_CGC@ -cqu "$(srcdir)/../mac/rename-app.rkt" "$(prefix)/GRacket@CGC_CAP_INSTALLED@.app" "GRacket@CGC@" "GRacket@CGC_CAP_INSTALLED@"
-	/usr/bin/install_name_tool -change "@executable_path/../../../Racket.framework/Versions/$(FWVERSION)/Racket" "@FRAMEWORK_PREFIX@Racket.framework/Versions/$(FWVERSION)/Racket" "$(prefix)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@"
+	/usr/bin/install_name_tool -change "@executable_path/../../../../racket/Racket.framework/Versions/$(FWVERSION)/Racket" "@FRAMEWORK_PREFIX@Racket.framework/Versions/$(FWVERSION)/Racket" "$(prefix)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@"
 	@RUN_RACKET_CGC@ -cu "$(srcdir)/../racket/collects-path.rkt" "$(prefix)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@" ../../../collects
 	@STRIP_DEBUG@ "$(prefix)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@"
 
diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc
index 8fd36f5f7a..93385072c0 100644
--- a/src/racket/cmdline.inc
+++ b/src/racket/cmdline.inc
@@ -860,7 +860,11 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	  }
 	  argv++;
 	  --argc;
-	  collects_path = check_make_path(prog, real_switch, argv[0]);
+          if (!*(argv[0])) {
+            /* #f => no collects path */
+            collects_path = scheme_make_false();
+          } else
+            collects_path = check_make_path(prog, real_switch, argv[0]);
           was_config_flag = 1;
 	  break;
 	case 'A':
@@ -1175,16 +1179,19 @@ static int run_from_cmd_line(int argc, char *_argv[],
 #ifndef NO_FILE_SYSTEM_UTILS
   /* Setup path for "collects" collection directory: */
   if (!collects_path) {
-    if (!_coldir[_coldir_offset]) {
-      /* empty list of directories => don't set collection dirs
-         and don't use collection links files */
-      skip_coll_dirs = 1;
-      scheme_set_ignore_link_paths(1);
-      collects_path = scheme_make_path(".");
-    } else
+    if (!_coldir[_coldir_offset])
+      collects_path = scheme_make_false();
+    else
       collects_path = scheme_make_path(_coldir XFORM_OK_PLUS _coldir_offset);
-  } else
+  } else if (!SAME_OBJ(collects_path, scheme_make_false()))
     collects_path = scheme_path_to_complete_path(collects_path, NULL);
+  if (SAME_OBJ(collects_path, scheme_make_false())) {
+    /* empty list of directories => don't set collection dirs
+       and don't use collection links files */
+    skip_coll_dirs = 1;
+    scheme_set_ignore_link_paths(1);
+    collects_path = scheme_make_path(".");
+  }
   scheme_set_collects_path(collects_path);
 
   /* Make list of additional collection paths: */
@@ -1343,7 +1350,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	 "  -z, --text-repl : Use text `read-eval-print-loop' for -i\n"
 # endif
          "  -I <path> : Set <init-lib> to <path>\n"
-	 "  -X <dir>, --collects <dir> : Main collects at <dir>\n"
+	 "  -X <dir>, --collects <dir> : Main collects at <dir> (or \"\" disables all)\n"
 	 "  -S <dir>, --search <dir> : More collects at <dir> (after main collects)\n"
 	 "  -A <dir>, --addon <dir> : Addon directory at <dir>\n"
 	 "  -K <file>, --links <file> : User-specific collection links at <file>\n"
diff --git a/src/racket/gc2/gc2.h b/src/racket/gc2/gc2.h
index f7e61cdb8d..01c5de839a 100644
--- a/src/racket/gc2/gc2.h
+++ b/src/racket/gc2/gc2.h
@@ -33,7 +33,8 @@ typedef void (*GC_collect_start_callback_Proc)(void);
 typedef void (*GC_collect_end_callback_Proc)(void);
 typedef void (*GC_collect_inform_callback_Proc)(int master_gc, int major_gc, 
                                                 intptr_t pre_used, intptr_t post_used,
-                                                intptr_t pre_admin, intptr_t post_admin);
+                                                intptr_t pre_admin, intptr_t post_admin,
+                                                intptr_t post_child_places_used);
 typedef uintptr_t (*GC_get_thread_stack_base_Proc)(void);
 typedef void (*GC_Post_Propagate_Hook_Proc)(struct NewGC *);
 /* 
@@ -105,11 +106,13 @@ GC2_EXTERN void GC_register_root_custodian(void *);
 
 GC2_EXTERN void GC_register_new_thread(void *, void *);
 /*
-   Indicates that a just-allocated point is for a thread record
-   owned by a particular custodian. */
+   Indicates that a just-allocated point is for a thread 
+   or place owned by a particular custodian. */
+
 GC2_EXTERN void GC_register_thread(void *, void *);
 /*
-   Indicates that a a thread record is owned by a particular custodian. */
+   Indicates that a a thread or place is now owned by a
+   particular custodian. */
 
 GC2_EXTERN GC_collect_start_callback_Proc GC_set_collect_start_callback(GC_collect_start_callback_Proc);
 GC2_EXTERN GC_collect_end_callback_Proc GC_set_collect_end_callback(GC_collect_end_callback_Proc);
@@ -150,6 +153,11 @@ GC2_EXTERN int GC_set_account_hook(int type, void *c1, uintptr_t b, void *c2);
   Set a memory-accounting property. Returns 0 for failure (i.e., not
   supported). */
 
+GC2_EXTERN uintptr_t GC_get_account_memory_limit(void *c1);
+/*
+  Returns a moemory accounting limit for c1 (or any ancestor),
+  or 0 if none is set. */
+
 GC2_EXTERN void GC_gcollect(void);
 /*
    Performs an immediate (full) collection. */
@@ -433,19 +441,33 @@ GC2_EXTERN void GC_write_barrier(void *p);
    Explicit write barrier to ensure that a write-barrier signal is not
    triggered by a memory write.
 */
+
 GC2_EXTERN void GC_switch_out_master_gc();
 /*
    Makes the current GC the master GC.
    Creates a new place specific GC and links it to the master GC.
 */
-GC2_EXTERN void GC_construct_child_gc();
+
+GC2_EXTERN struct NewGC *GC_get_current_instance();
 /*
-   Creates a new place specific GC and links to the master GC.
+   Returns a representation of the current GC.
 */
 
+GC2_EXTERN void GC_construct_child_gc(struct NewGC *parent_gc, intptr_t limit);
+/*
+   Creates a new place-specific GC that is a child for memory-accounting
+   purposes of the give parent GC. If `limit' is not 0, set the maximum
+   amount of memory the new GC is supposed to use.
+*/
+
+GC2_EXTERN intptr_t GC_propagate_hierarchy_memory_use();
+/* 
+   Notifies the parent GC (if any) of memory use by the current GC
+   and its children. The result is total memory use. */
+
 GC2_EXTERN void GC_destruct_child_gc();
 /*
-   Destroys a place specific GC once the place has finished.
+   Destroys a place-specific GC once the place has finished.
 */
 
 GC2_EXTERN void *GC_switch_to_master_gc();
diff --git a/src/racket/gc2/mem_account.c b/src/racket/gc2/mem_account.c
index 9516c46fbc..565484c77a 100644
--- a/src/racket/gc2/mem_account.c
+++ b/src/racket/gc2/mem_account.c
@@ -12,6 +12,8 @@ static const int btc_redirect_custodian = 510;
 static const int btc_redirect_ephemeron = 509;
 static const int btc_redirect_cust_box  = 508;
 
+inline static void account_memory(NewGC *gc, int set, intptr_t amount);
+
 /*****************************************************************************/
 /* thread list                                                               */
 /*****************************************************************************/
@@ -23,7 +25,10 @@ inline static void BTC_register_new_thread(void *t, void *c)
   GC_Thread_Info *work;
 
   work = (GC_Thread_Info *)ofm_malloc(sizeof(GC_Thread_Info));
-  ((Scheme_Thread *)t)->gc_info = work;
+  if (((Scheme_Object *)t)->type == scheme_thread_type)
+    ((Scheme_Thread *)t)->gc_info = work;
+  else
+    ((Scheme_Place *)t)->gc_info = work;
   work->owner = current_owner(gc, (Scheme_Custodian *)c);
   work->thread = t;
 
@@ -35,8 +40,11 @@ inline static void BTC_register_thread(void *t, void *c)
 {
   NewGC *gc = GC_get_GC();
   GC_Thread_Info *work;
-
-  work = ((Scheme_Thread *)t)->gc_info;
+  
+  if (((Scheme_Object *)t)->type == scheme_thread_type)
+    work = ((Scheme_Thread *)t)->gc_info;
+  else
+    work = ((Scheme_Place *)t)->gc_info;
   work->owner = current_owner(gc, (Scheme_Custodian *)c);
 }
 
@@ -45,15 +53,32 @@ inline static void mark_threads(NewGC *gc, int owner)
   GC_Thread_Info *work;
   Mark2_Proc thread_mark = gc->mark_table[btc_redirect_thread];
 
-  for(work = gc->thread_infos; work; work = work->next)
-    if(work->owner == owner) {
-      if (((Scheme_Thread *)work->thread)->running) {
-        thread_mark(work->thread, gc);
-        if (work->thread == scheme_current_thread) {
-          GC_mark_variable_stack(GC_variable_stack, 0, get_stack_base(gc), NULL);
+  for(work = gc->thread_infos; work; work = work->next) {
+    if (work->owner == owner) {
+      if (((Scheme_Object *)work->thread)->type == scheme_thread_type) {
+        /* thread */
+        if (((Scheme_Thread *)work->thread)->running) {
+          thread_mark(work->thread, gc);
+          if (work->thread == scheme_current_thread) {
+            GC_mark_variable_stack(GC_variable_stack, 0, get_stack_base(gc), NULL);
+          }
         }
+      } else {
+        /* place */
+#ifdef MZ_USE_PLACES
+        /* add in the memory used by the place's GC */
+        intptr_t sz;
+        Scheme_Place_Object *place_obj = ((Scheme_Place *)work->thread)->place_obj;
+        if (place_obj) {
+          mzrt_mutex_lock(place_obj->lock);
+          sz = place_obj->memory_use;
+          mzrt_mutex_unlock(place_obj->lock);
+          account_memory(gc, owner, gcBYTES_TO_WORDS(sz));
+        }
+#endif
       }
     }
+  }
 }
 
 inline static void clean_up_thread_list(NewGC *gc)
@@ -355,10 +380,10 @@ inline static void BTC_initialize_mark_table(NewGC *gc) {
 }
 
 inline static int BTC_get_redirect_tag(NewGC *gc, int tag) {
-  if (tag == scheme_thread_type )         { tag = btc_redirect_thread; }
-  else if (tag == scheme_custodian_type ) { tag = btc_redirect_custodian; }
-  else if (tag == gc->ephemeron_tag )     { tag = btc_redirect_ephemeron; }
-  else if (tag == gc->cust_box_tag )      { tag = btc_redirect_cust_box; }
+  if (tag == scheme_thread_type)         { tag = btc_redirect_thread; }
+  else if (tag == scheme_custodian_type) { tag = btc_redirect_custodian; }
+  else if (tag == gc->ephemeron_tag)     { tag = btc_redirect_ephemeron; }
+  else if (tag == gc->cust_box_tag)      { tag = btc_redirect_cust_box; }
   return tag;
 }
 
@@ -535,7 +560,7 @@ inline static void BTC_run_account_hooks(NewGC *gc)
   AccountHook *work = gc->hooks; 
   AccountHook *prev = NULL;
 
-  while(work) {
+  while (work) {
     if( ((work->type == MZACCT_REQUIRE) && 
           ((gc->used_pages > (gc->max_pages_for_use / 2))
            || ((((gc->max_pages_for_use / 2) - gc->used_pages) * APAGE_SIZE)
@@ -563,7 +588,7 @@ static uintptr_t custodian_single_time_limit(NewGC *gc, int set)
   const int table_size = gc->owner_table_size;
 
   if (!set)
-    return (uintptr_t)(intptr_t)-1;
+    return gc->place_memory_limit;
 
   if (gc->reset_limits) {
     int i;
@@ -575,7 +600,7 @@ static uintptr_t custodian_single_time_limit(NewGC *gc, int set)
 
   if (!owner_table[set]->limit_set) {
     /* Check for limits on this custodian or one of its ancestors: */
-    uintptr_t limit = (uintptr_t)-1;
+    uintptr_t limit = gc->place_memory_limit;
     Scheme_Custodian *orig = (Scheme_Custodian *) owner_table[set]->originator, *c;
     AccountHook *work = gc->hooks;
 
@@ -614,21 +639,39 @@ intptr_t BTC_get_memory_use(NewGC* gc, void *o)
   return 0;
 }
 
-int BTC_single_allocation_limit(NewGC *gc, size_t sizeb) {
-  /* We're allowed to fail. Check for allocations that exceed a single-time
-   * limit. Otherwise, the limit doesn't work as intended, because
-   * a program can allocate a large block that nearly exhausts memory,
-   * and then a subsequent allocation can fail. As long as the limit
-   * is much smaller than the actual available memory, and as long as
-   * GC_out_of_memory protects any user-requested allocation whose size
-   * is independent of any existing object, then we can enforce the limit. */
+int BTC_single_allocation_limit(NewGC *gc, size_t sizeb) 
+/* Use this function to check for allocations that exceed a single-time
+ * limit. Otherwise, the limit doesn't work as intended, because
+ * a program can allocate a large block that nearly exhausts memory,
+ * and then a subsequent allocation can fail. As long as the limit
+ * is much smaller than the actual available memory, and as long as
+ * GC_out_of_memory protects any user-requested allocation whose size
+ * is independent of any existing object, then we can enforce the limit. */
+{
   Scheme_Thread *p = scheme_current_thread;
   if (p)
     return (custodian_single_time_limit(gc, thread_get_owner(p)) < sizeb);
   else
-    return 0;
+    return (gc->place_memory_limit < sizeb);
 }
 
+static uintptr_t BTC_get_account_hook(void *c1)
+{
+  NewGC *gc = GC_get_GC();
+  uintptr_t mem;
+
+  if (!gc->really_doing_accounting)
+    return 0;
+
+  mem = custodian_single_time_limit(gc, custodian_to_owner_set(gc, c1));
+  
+  if (mem == (uintptr_t)(intptr_t)-1)
+    return 0;
+
+  return mem;
+}
+
+
 static inline void BTC_clean_up(NewGC *gc) {
   clean_up_thread_list(gc);
   clean_up_owner_table(gc);
diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c
index ed6a4479e4..9bd3b93d6e 100644
--- a/src/racket/gc2/newgc.c
+++ b/src/racket/gc2/newgc.c
@@ -5,9 +5,7 @@
    Please see full copyright in the documentation
    Search for "FIXME" for known improvement points 
 
-   IF YOU'RE NOT ADAM (AND PROBABLY IF YOU ARE) READ THIS FIRST:
-
-   This is now a hybrid copying/mark-compact collector. The nursery
+   This is a hybrid copying/mark-compact collector. The nursery
    (generation 0) is copied into the old generation (generation 1),
    but the old generation compacts. This yields a nice combination
    of performance, scalability and memory efficiency.
@@ -889,20 +887,15 @@ static void *allocate_big(const size_t request_size_bytes, int type)
 #ifdef NEWGC_BTC_ACCOUNT
   if(GC_out_of_memory) {
 #ifdef MZ_USE_PLACES 
-  if (premaster_or_place_gc(gc)) {
+    if (premaster_or_place_gc(gc)) {
 #endif
-    if (BTC_single_allocation_limit(gc, request_size_bytes)) {
-      /* We're allowed to fail. Check for allocations that exceed a single-time
-         limit. Otherwise, the limit doesn't work as intended, because
-         a program can allocate a large block that nearly exhausts memory,
-         and then a subsequent allocation can fail. As long as the limit
-         is much smaller than the actual available memory, and as long as
-         GC_out_of_memory protects any user-requested allocation whose size
-         is independent of any existing object, then we can enforce the limit. */
-      GC_out_of_memory();
-    }
+      if (BTC_single_allocation_limit(gc, request_size_bytes)) {
+        /* We're allowed to fail. Check for allocations that exceed a single-time
+           limit. See BTC_single_allocation_limit() for more information. */
+        GC_out_of_memory();
+      }
 #ifdef MZ_USE_PLACES 
-  }
+    }
 #endif
   }
 #endif
@@ -1666,7 +1659,7 @@ inline static void master_set_max_size(NewGC *gc)
 
 inline static void reset_nursery(NewGC *gc)
 {
-  uintptr_t new_gen0_size; 
+  uintptr_t new_gen0_size;
   new_gen0_size = NUM((GEN0_SIZE_FACTOR * (float)gc->memory_in_use) + GEN0_SIZE_ADDITION);
   if(new_gen0_size > GEN0_MAX_SIZE)
     new_gen0_size = GEN0_MAX_SIZE;
@@ -2255,12 +2248,28 @@ int GC_set_account_hook(int type, void *c1, uintptr_t b, void *c2)
 #endif
 }
 
+uintptr_t GC_get_account_memory_limit(void *c1)
+{
+#ifdef NEWGC_BTC_ACCOUNT
+  NewGC *gc = GC_get_GC();
+  uintptr_t v = BTC_get_account_hook(c1);
+  if (gc->place_memory_limit < (uintptr_t)(intptr_t)-1) {
+    if (!v || (gc->place_memory_limit < v))
+      return gc->place_memory_limit;
+  }
+  return v;
+#else
+  return 0;
+#endif
+}
+
 void GC_register_thread(void *t, void *c)
 {
 #ifdef NEWGC_BTC_ACCOUNT
   BTC_register_thread(t, c);
 #endif
 }
+
 void GC_register_new_thread(void *t, void *c)
 {
 #ifdef NEWGC_BTC_ACCOUNT
@@ -2560,14 +2569,15 @@ void GC_set_put_external_event_fd(void *fd) {
 }
 #endif
 
-static void NewGC_initialize(NewGC *newgc, NewGC *parentgc) {
-  if (parentgc) {
-    newgc->mark_table  = parentgc->mark_table;
-    newgc->fixup_table = parentgc->fixup_table;
-    newgc->dumping_avoid_collection = parentgc->dumping_avoid_collection - 1;
-  }
-  else {
-
+static void NewGC_initialize(NewGC *newgc, NewGC *inheritgc, NewGC *parentgc) {
+  if (inheritgc) {
+    newgc->mark_table  = inheritgc->mark_table;
+    newgc->fixup_table = inheritgc->fixup_table;
+    newgc->dumping_avoid_collection = inheritgc->dumping_avoid_collection - 1;
+#ifdef MZ_USE_PLACES
+    newgc->parent_gc = parentgc;
+#endif
+  } else {
 #ifdef MZ_USE_PLACES
     NewGCMasterInfo_initialize();
 #endif
@@ -2595,10 +2605,17 @@ static void NewGC_initialize(NewGC *newgc, NewGC *parentgc) {
   newgc->generations_available = 1;
   newgc->last_full_mem_use = (20 * 1024 * 1024);
   newgc->new_btc_mark = 1;
+
+  newgc->place_memory_limit = (uintptr_t)(intptr_t)-1;
+
+#ifdef MZ_USE_PLACES
+  mzrt_mutex_create(&newgc->child_total_lock);
+#endif
 }
 
 /* NOTE This method sets the constructed GC as the new Thread Specific GC. */
-static NewGC *init_type_tags_worker(NewGC *parentgc, int count, int pair, int mutable_pair, int weakbox, int ephemeron, int weakarray, int custbox)
+static NewGC *init_type_tags_worker(NewGC *inheritgc, NewGC *parentgc, 
+                                    int count, int pair, int mutable_pair, int weakbox, int ephemeron, int weakarray, int custbox)
 {
   NewGC *gc;
 
@@ -2617,7 +2634,7 @@ static NewGC *init_type_tags_worker(NewGC *parentgc, int count, int pair, int mu
   gc->cust_box_tag    = custbox;
 # endif
 
-  NewGC_initialize(gc, parentgc);
+  NewGC_initialize(gc, inheritgc, parentgc);
 
 
   /* Our best guess at what the OS will let us allocate: */
@@ -2631,7 +2648,7 @@ static NewGC *init_type_tags_worker(NewGC *parentgc, int count, int pair, int mu
   gc->gen0.page_alloc_size = GEN0_PAGE_SIZE;
   resize_gen0(gc, GEN0_INITIAL_SIZE);
 
-  if (!parentgc) {
+  if (!inheritgc) {
     GC_register_traversers2(gc->weak_box_tag, size_weak_box, mark_weak_box, fixup_weak_box, 0, 0);
     GC_register_traversers2(gc->ephemeron_tag, size_ephemeron, mark_ephemeron, fixup_ephemeron, 0, 0);
     GC_register_traversers2(gc->weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array, 0, 0);
@@ -2647,22 +2664,27 @@ void GC_init_type_tags(int count, int pair, int mutable_pair, int weakbox, int e
 {
   static int initialized = 0;
 
-  if(!initialized) {
+  if (!initialized) {
     initialized = 1;
-    init_type_tags_worker(NULL, count, pair, mutable_pair, weakbox, ephemeron, weakarray, custbox);
-  }
-  else {
+    init_type_tags_worker(NULL, NULL, count, pair, mutable_pair, weakbox, ephemeron, weakarray, custbox);
+  } else {
     GCPRINT(GCOUTF, "GC_init_type_tags should only be called once!\n");
     abort();
   }
 }
 
+struct NewGC *GC_get_current_instance() {
+  return GC_get_GC();
+}
+
 #ifdef MZ_USE_PLACES
-void GC_construct_child_gc() {
+void GC_construct_child_gc(struct NewGC *parent_gc, intptr_t limit) {
   NewGC *gc = MASTERGC;
-  NewGC *newgc = init_type_tags_worker(gc, 0, 0, 0, gc->weak_box_tag, gc->ephemeron_tag, gc->weak_array_tag, gc->cust_box_tag);
+  NewGC *newgc = init_type_tags_worker(gc, parent_gc, 0, 0, 0, gc->weak_box_tag, gc->ephemeron_tag, gc->weak_array_tag, gc->cust_box_tag);
   newgc->primoridal_gc = MASTERGC;
   newgc->dont_master_gc_until_child_registers = 1;
+  if (limit)
+    newgc->place_memory_limit = limit;
 }
 
 void GC_destruct_child_gc() {
@@ -2729,7 +2751,7 @@ void GC_switch_out_master_gc() {
     MASTERGC->dumping_avoid_collection++;
 
     save_globals_to_gc(MASTERGC);
-    GC_construct_child_gc();
+    GC_construct_child_gc(NULL, 0);
     GC_allow_master_gc_check();
   }
   else {
@@ -2825,12 +2847,19 @@ void GC_register_traversers(short tag, Size_Proc size, Mark_Proc mark,
 intptr_t GC_get_memory_use(void *o) 
 {
   NewGC *gc = GC_get_GC();
+  intptr_t amt;
 #ifdef NEWGC_BTC_ACCOUNT
   if(o) {
     return BTC_get_memory_use(gc, o);
   }
 #endif
-  return gen0_size_in_use(gc) + gc->memory_in_use;
+  amt = gen0_size_in_use(gc) + gc->memory_in_use;
+#ifdef MZ_USE_PLACES
+  mzrt_mutex_lock(gc->child_total_lock);
+  amt += gc->child_gc_total;
+  mzrt_mutex_unlock(gc->child_total_lock);
+#endif
+  return amt;
 }
 
 /*****************************************************************************/
@@ -4526,7 +4555,8 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master, Log
 #endif
     gc->GC_collect_inform_callback(is_master, gc->gc_full, 
                                    old_mem_use + old_gen0, gc->memory_in_use, 
-                                   old_mem_allocated, mmu_memory_allocated(gc->mmu));
+                                   old_mem_allocated, mmu_memory_allocated(gc->mmu),
+                                   gc->child_gc_total);
   }
 #ifdef MZ_USE_PLACES
   if (lmi) {
@@ -4537,6 +4567,7 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master, Log
     lmi->pre_admin = old_mem_allocated;
     lmi->post_admin = mmu_memory_allocated(gc->mmu);
   }
+  GC_propagate_hierarchy_memory_use();
 #endif
 
   TIME_STEP("ended");
@@ -4601,7 +4632,8 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master, Log
         if (gc->GC_collect_inform_callback) {
           gc->GC_collect_inform_callback(1, sub_lmi.full,
                                          sub_lmi.pre_used, sub_lmi.post_used,
-                                         sub_lmi.pre_admin, sub_lmi.post_admin);
+                                         sub_lmi.pre_admin, sub_lmi.post_admin,
+                                         0);
         }
       }
     }
@@ -4609,6 +4641,25 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master, Log
 #endif
 }
 
+intptr_t GC_propagate_hierarchy_memory_use() 
+{
+  NewGC *gc = GC_get_GC();
+
+#ifdef MZ_USE_PLACES
+  if (gc->parent_gc) {
+    /* report memory use to parent */
+    intptr_t total = gc->memory_in_use + gc->child_gc_total;
+    intptr_t delta = total - gc->previously_reported_total;
+    mzrt_mutex_lock(gc->parent_gc->child_total_lock);
+    gc->parent_gc->child_gc_total += delta;
+    mzrt_mutex_unlock(gc->parent_gc->child_total_lock);
+    gc->previously_reported_total = total;
+  }
+#endif
+
+  return gc->memory_in_use + gc->child_gc_total;
+}
+
 #if MZ_GC_BACKTRACE
 
 static GC_get_type_name_proc stack_get_type_name;
diff --git a/src/racket/gc2/newgc.h b/src/racket/gc2/newgc.h
index 98234c6693..33f8839449 100644
--- a/src/racket/gc2/newgc.h
+++ b/src/racket/gc2/newgc.h
@@ -245,6 +245,15 @@ typedef struct NewGC {
 
   Allocator *saved_allocator;
 
+#ifdef MZ_USE_PLACES
+  struct NewGC *parent_gc; /* parent for the purpose of reporting memory use */
+  intptr_t previously_reported_total; /* how much we previously reported to the parent */
+  mzrt_mutex *child_total_lock; /* lock on `child_gc_total' */
+#endif
+  intptr_t child_gc_total;
+
+  uintptr_t place_memory_limit; /* set to propagate a custodian limit from a parent place */  
+
 #if defined(GC_DEBUG_PAGES)
   FILE *GCVERBOSEFH;
 #endif
diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h
index e4755fbf28..48047efb84 100644
--- a/src/racket/include/schthread.h
+++ b/src/racket/include/schthread.h
@@ -122,6 +122,7 @@ typedef struct Thread_Local_Variables {
   uintptr_t GC_gen0_alloc_page_ptr_;
   uintptr_t GC_gen0_alloc_page_end_;
   int GC_gen0_alloc_only_;
+  uintptr_t force_gc_for_place_accounting_;
   void *bignum_cache_[BIGNUM_CACHE_SIZE];
   int cache_count_;
   struct Scheme_Hash_Table *toplevels_ht_;
@@ -149,7 +150,7 @@ typedef struct Thread_Local_Variables {
   struct Scheme_Object *cached_mod_beg_stx_;
   struct Scheme_Object *cached_dv_stx_;
   struct Scheme_Object *cached_ds_stx_;
-  struct Scheme_Object *cached_dvs_stx_;
+  struct Scheme_Object *cached_bfs_stx_;
   int cached_stx_phase_;
   struct Scheme_Object *cwv_stx_;
   int cwv_stx_phase_;
@@ -459,6 +460,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define GC_gen0_alloc_page_end XOA (scheme_get_thread_local_variables()->GC_gen0_alloc_page_end_)
 #define GC_gen0_alloc_only XOA (scheme_get_thread_local_variables()->GC_gen0_alloc_only_)
 #define GC_variable_stack XOA (scheme_get_thread_local_variables()->GC_variable_stack_)
+#define force_gc_for_place_accounting XOA (scheme_get_thread_local_variables()->force_gc_for_place_accounting_)
 #define bignum_cache XOA (scheme_get_thread_local_variables()->bignum_cache_)
 #define cache_count XOA (scheme_get_thread_local_variables()->cache_count_)
 #define toplevels_ht XOA (scheme_get_thread_local_variables()->toplevels_ht_)
@@ -486,7 +488,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define cached_mod_beg_stx XOA (scheme_get_thread_local_variables()->cached_mod_beg_stx_)
 #define cached_dv_stx XOA (scheme_get_thread_local_variables()->cached_dv_stx_)
 #define cached_ds_stx XOA (scheme_get_thread_local_variables()->cached_ds_stx_)
-#define cached_dvs_stx XOA (scheme_get_thread_local_variables()->cached_dvs_stx_)
+#define cached_bfs_stx XOA (scheme_get_thread_local_variables()->cached_bfs_stx_)
 #define cached_stx_phase XOA (scheme_get_thread_local_variables()->cached_stx_phase_)
 #define cwv_stx XOA (scheme_get_thread_local_variables()->cwv_stx_)
 #define cwv_stx_phase XOA (scheme_get_thread_local_variables()->cwv_stx_phase_)
diff --git a/src/racket/src/compenv.c b/src/racket/src/compenv.c
index 9544fb0b56..0505864fde 100644
--- a/src/racket/src/compenv.c
+++ b/src/racket/src/compenv.c
@@ -1883,7 +1883,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
 
   /* Try syntax table: */
   if (modname) {
-    val = scheme_module_syntax(modname, env->genv, find_id);
+    val = scheme_module_syntax(modname, env->genv, find_id, SCHEME_INT_VAL(mod_defn_phase));
     if (val && !(flags & SCHEME_NO_CERT_CHECKS))
       scheme_check_accessible_in_module(genv, env->insp, in_modidx, 
 					find_id, src_find_id, NULL, NULL, rename_insp,
diff --git a/src/racket/src/compile.c b/src/racket/src/compile.c
index 8648ae2cb0..b015547653 100644
--- a/src/racket/src/compile.c
+++ b/src/racket/src/compile.c
@@ -108,8 +108,8 @@ static Scheme_Object *quote_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *
 static Scheme_Object *quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
 static Scheme_Object *define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
 static Scheme_Object *define_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
-static Scheme_Object *define_for_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
-static Scheme_Object *define_for_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
+static Scheme_Object *begin_for_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
+static Scheme_Object *begin_for_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
 static Scheme_Object *letrec_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
 static Scheme_Object *letrec_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
 
@@ -273,9 +273,9 @@ void scheme_init_compile (Scheme_Env *env)
 							quote_syntax_expand), 
 			    env);
   scheme_add_global_keyword("define-syntaxes", scheme_define_syntaxes_syntax, env);
-  scheme_add_global_keyword("define-values-for-syntax", 
-			    scheme_make_compiled_syntax(define_for_syntaxes_syntax, 
-							define_for_syntaxes_expand),
+  scheme_add_global_keyword("begin-for-syntax", 
+			    scheme_make_compiled_syntax(begin_for_syntax_syntax, 
+							begin_for_syntax_expand),
 			    env);
   scheme_add_global_keyword("letrec-syntaxes+values", 
 			    scheme_make_compiled_syntax(letrec_syntaxes_syntax, 
@@ -3135,7 +3135,7 @@ single_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info
   form_name = SCHEME_STX_CAR(form);
 
   if (simplify && (erec[drec].depth == -1)) {
-    /* FIXME: this needs EXPAND_OBSERVE callbacks. */
+    /* FIXME [Ryan?]: this needs EXPAND_OBSERVE callbacks? */
     expr = scheme_stx_track(expr, form, form_name);
     SCHEME_EXPAND_OBSERVE_TAG(erec[drec].observer,expr);
     return expr;
@@ -3224,6 +3224,19 @@ quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Inf
 /*                          define-syntaxes                           */
 /**********************************************************************/
 
+static void prep_exp_env_compile_rec(Scheme_Compile_Info *rec, int drec)
+{
+  rec[0].comp = 1;
+  rec[0].dont_mark_local_use = 0;
+  rec[0].resolve_module_ids = 0;
+  rec[0].value_name = NULL;
+  rec[0].observer = NULL;
+  rec[0].pre_unwrapped = 0;
+  rec[0].testing_constantness = 0;
+  rec[0].env_already = 0;
+  rec[0].comp_flags = rec[drec].comp_flags;
+}
+
 static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
 {
   Scheme_Env *env = (Scheme_Env *)_env;
@@ -3233,7 +3246,7 @@ static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
 
 static Scheme_Object *
 do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, 
-			  Scheme_Compile_Info *rec, int drec, int for_stx)
+			  Scheme_Compile_Info *rec, int drec)
 {
   Scheme_Object *names, *code, *dummy;
   Scheme_Object *val, *vec;
@@ -3248,27 +3261,13 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
   scheme_prepare_exp_env(env->genv);
   scheme_prepare_compile_env(env->genv->exp_env);
 
-  if (!for_stx)
-    names = scheme_named_map_1(NULL, stx_val, names, (Scheme_Object *)env->genv);
+  names = scheme_named_map_1(NULL, stx_val, names, (Scheme_Object *)env->genv);
 
   exp_env = scheme_new_comp_env(env->genv->exp_env, env->insp, 0);
 
   dummy = scheme_make_environment_dummy(env);
-  
-  rec1.comp = 1;
-  rec1.dont_mark_local_use = 0;
-  rec1.resolve_module_ids = 0;
-  rec1.value_name = NULL;
-  rec1.observer = NULL;
-  rec1.pre_unwrapped = 0;
-  rec1.testing_constantness = 0;
-  rec1.env_already = 0;
-  rec1.comp_flags = rec[drec].comp_flags;
 
-  if (for_stx) {
-    names = defn_targets_syntax(names, exp_env, &rec1, 0);
-    scheme_compile_rec_done_local(&rec1, 0);
-  }
+  prep_exp_env_compile_rec(&rec1, 0);
 
   val = scheme_compile_expr_lift_to_let(code, exp_env, &rec1, 0);
 
@@ -3278,7 +3277,7 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
   SCHEME_VEC_ELS(vec)[2] = names;
   SCHEME_VEC_ELS(vec)[3] = val;
 
-  vec->type = (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type);
+  vec->type = scheme_define_syntaxes_type;
 
   scheme_merge_undefineds(exp_env, env);
 
@@ -3289,14 +3288,7 @@ static Scheme_Object *
 define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, 
 		       Scheme_Compile_Info *rec, int drec)
 {
-  return do_define_syntaxes_syntax(form, env, rec, drec, 0);
-}
-
-static Scheme_Object *
-define_for_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, 
-			   Scheme_Compile_Info *rec, int drec)
-{
-  return do_define_syntaxes_syntax(form, env, rec, drec, 1);
+  return do_define_syntaxes_syntax(form, env, rec, drec);
 }
 
 static Scheme_Object *
@@ -3328,9 +3320,91 @@ define_syntaxes_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Ex
 }
 
 static Scheme_Object *
-define_for_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
+begin_for_syntax_expand(Scheme_Object *orig_form, Scheme_Comp_Env *in_env, Scheme_Expand_Info *rec, int drec)
 {
-  return define_syntaxes_expand(form, env, erec, drec);
+  Scheme_Expand_Info recs[1];
+  Scheme_Object *form, *context_key, *l, *fn, *vec, *dummy;
+  Scheme_Comp_Env *env;
+
+  /* FIXME [Ryan?]: */
+  /* SCHEME_EXPAND_OBSERVE_PRIM_DEFINE_SYNTAXES(erec[drec].observer); */
+
+  form = orig_form;
+
+  if (!scheme_is_toplevel(in_env))
+    scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)");
+
+  (void)check_form(form, form);
+
+  scheme_prepare_exp_env(in_env->genv);
+  scheme_prepare_compile_env(in_env->genv->exp_env);
+
+  if (rec[drec].comp)
+    env = scheme_new_comp_env(in_env->genv->exp_env, in_env->insp, 0);
+  else
+    env = scheme_new_expand_env(in_env->genv->exp_env, in_env->insp, 0);
+
+  if (rec[drec].comp)
+    dummy = scheme_make_environment_dummy(in_env);
+  else
+    dummy = NULL;
+
+  context_key = scheme_generate_lifts_key();
+  
+  l = SCHEME_STX_CDR(form);
+  form = scheme_null;
+
+  while (1) {
+    scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env),
+                                scheme_false, scheme_false, scheme_null, scheme_false);
+
+    if (rec[drec].comp) {
+      scheme_init_compile_recs(rec, drec, recs, 1);
+      prep_exp_env_compile_rec(recs, 0);
+      l = scheme_compile_list(l, env, recs, 0);
+    } else {
+      scheme_init_expand_recs(rec, drec, recs, 1);
+      l = scheme_expand_list(l, env, recs, 0);
+    }
+
+    if (SCHEME_NULLP(form))
+      form = l;
+    else
+      form = scheme_append(l, form);
+    
+    l = scheme_frame_get_lifts(env);
+    if (SCHEME_NULLP(l)) {
+      /* No lifts */
+      if (rec[drec].comp)
+        scheme_merge_compile_recs(rec, drec, NULL, 1); /* fix this if merge changes to do something */
+      break;
+    } else {
+      /* We have lifts: */
+      /* FIXME [Ryan?]: need some expand-observe callback here? */
+    }
+  }
+
+  if (rec[drec].comp) {
+    vec = scheme_make_vector(4, NULL);
+    SCHEME_VEC_ELS(vec)[0] = (Scheme_Object *)env->prefix;
+    SCHEME_VEC_ELS(vec)[1] = dummy;
+    SCHEME_VEC_ELS(vec)[2] = form;
+    vec->type = scheme_begin_for_syntax_type;
+
+    return vec;
+  } else {
+    fn = SCHEME_STX_CAR(orig_form);
+    return scheme_datum_to_syntax(cons(fn, form), 
+                                  orig_form, orig_form,
+                                  0, 2);
+  }
+}
+
+static Scheme_Object *
+begin_for_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env, 
+                        Scheme_Compile_Info *rec, int drec)
+{
+  return begin_for_syntax_expand(form, env, rec, drec);
 }
 
 Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env)
@@ -4325,7 +4399,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
 
 #if 1
   if (!SCHEME_STXP(form))
-    scheme_signal_error("not syntax");
+    scheme_signal_error("internal error: not syntax");
 #endif
 
   if (rec[drec].comp) {
@@ -4338,7 +4412,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
     var = SCHEME_STX_VAL(form);
     if (scheme_stx_has_empty_wraps(form)
         && same_effective_env(SCHEME_PTR2_VAL(var), env)) {
-      /* FIXME: this needs EXPAND_OBSERVE callbacks. */
+      /* FIXME [Ryan?]: this needs EXPAND_OBSERVE callbacks. */
       form = scheme_stx_track(SCHEME_PTR1_VAL(var), form, form);
       if (!rec[drec].comp && (rec[drec].depth != -1)) {
         /* Already fully expanded. */
diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc
index 52767c1fdb..af411a6375 100644
--- a/src/racket/src/cstartup.inc
+++ b/src/racket/src/cstartup.inc
@@ -1,26 +1,26 @@
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,22,
-0,26,0,31,0,38,0,51,0,58,0,63,0,68,0,72,0,79,0,82,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,17,
+0,22,0,29,0,42,0,49,0,54,0,59,0,63,0,70,0,73,0,82,0,
 85,0,91,0,105,0,119,0,122,0,128,0,132,0,134,0,145,0,147,0,161,
 0,168,0,190,0,192,0,206,0,17,1,46,1,57,1,68,1,93,1,126,1,
 159,1,218,1,17,2,95,2,150,2,155,2,175,2,68,3,88,3,140,3,206,
-3,95,4,237,4,34,5,45,5,124,5,0,0,69,7,0,0,69,35,37,109,
-105,110,45,115,116,120,29,11,11,68,104,101,114,101,45,115,116,120,63,108,101,
-116,64,99,111,110,100,66,117,110,108,101,115,115,72,112,97,114,97,109,101,116,
-101,114,105,122,101,66,100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,
-42,63,97,110,100,66,108,101,116,114,101,99,62,111,114,29,11,11,65,113,117,
+3,95,4,237,4,34,5,45,5,124,5,0,0,83,7,0,0,69,35,37,109,
+105,110,45,115,116,120,29,11,11,63,108,101,116,64,99,111,110,100,66,117,110,
+108,101,115,115,72,112,97,114,97,109,101,116,101,114,105,122,101,66,100,101,102,
+105,110,101,64,119,104,101,110,64,108,101,116,42,63,97,110,100,66,108,101,116,
+114,101,99,62,111,114,68,104,101,114,101,45,115,116,120,29,11,11,65,113,117,
 111,116,101,29,94,2,15,68,35,37,107,101,114,110,101,108,11,29,94,2,15,
 68,35,37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,110,63,115,
 116,120,61,115,70,108,101,116,45,118,97,108,117,101,115,61,120,73,108,101,116,
 114,101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,20,112,97,
 114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,61,118,73,
-100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,126,76,0,
-0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,20,2,4,
-2,2,2,6,2,2,2,8,2,2,2,7,2,2,2,9,2,2,2,10,2,
-2,2,11,2,2,2,5,2,2,2,12,2,2,2,13,2,2,97,37,11,8,
-240,126,76,0,0,93,159,2,16,36,37,16,2,2,3,161,2,2,37,2,3,
-2,2,2,3,96,11,11,8,240,126,76,0,0,16,0,96,38,11,8,240,126,
+100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,83,76,0,
+0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,20,2,3,
+2,2,2,5,2,2,2,7,2,2,2,6,2,2,2,8,2,2,2,9,2,
+2,2,10,2,2,2,4,2,2,2,11,2,2,2,12,2,2,97,37,11,8,
+240,83,76,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,37,2,13,
+2,2,2,13,96,38,11,8,240,83,76,0,0,16,0,96,11,11,8,240,83,
 76,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14,2,2,11,
 11,8,32,8,31,8,30,8,29,27,248,22,155,4,195,249,22,148,4,80,158,
 39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248,22,100,201,
@@ -28,16 +28,16 @@
 98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,22,155,4,196,
 28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,75,194,248,22,
 74,193,249,22,148,4,80,158,39,36,251,22,83,2,18,248,22,74,199,249,22,
-73,2,11,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,2,11,11,
+73,2,10,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,2,11,11,
 8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,
-52,56,48,57,16,4,11,11,2,21,3,1,8,101,110,118,49,52,56,49,48,
+52,55,51,57,16,4,11,11,2,21,3,1,8,101,110,118,49,52,55,52,48,
 27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,37,28,
 248,22,81,248,22,75,194,248,22,74,193,249,22,148,4,80,158,39,36,250,22,
 83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201,251,22,83,
-2,18,2,23,2,23,249,22,73,2,13,248,22,75,204,18,100,11,13,16,5,
+2,18,2,23,2,23,249,22,73,2,12,248,22,75,204,18,100,11,13,16,5,
 36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,
-3,1,8,101,110,118,49,52,56,49,50,16,4,11,11,2,21,3,1,8,101,
-110,118,49,52,56,49,51,248,22,155,4,193,27,248,22,155,4,194,249,22,73,
+3,1,8,101,110,118,49,52,55,52,50,16,4,11,11,2,21,3,1,8,101,
+110,118,49,52,55,52,51,248,22,155,4,193,27,248,22,155,4,194,249,22,73,
 248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,155,4,23,197,
 1,249,22,148,4,80,158,39,36,28,248,22,58,248,22,149,4,248,22,74,23,
 198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33,40,248,22,
@@ -51,7 +51,7 @@
 163,8,36,37,47,11,9,222,33,43,248,22,155,4,248,22,74,201,248,22,75,
 198,27,248,22,75,248,22,155,4,196,27,248,22,155,4,248,22,74,195,249,22,
 148,4,80,158,40,36,28,248,22,81,195,250,22,84,2,22,9,248,22,75,199,
-250,22,83,2,4,248,22,83,248,22,74,199,250,22,84,2,10,248,22,75,201,
+250,22,83,2,3,248,22,83,248,22,74,199,250,22,84,2,9,248,22,75,201,
 248,22,75,202,27,248,22,75,248,22,155,4,23,197,1,27,249,22,1,22,87,
 249,22,2,22,155,4,248,22,155,4,248,22,74,199,248,22,174,4,249,22,148,
 4,80,158,41,36,251,22,83,1,22,119,105,116,104,45,99,111,110,116,105,110,
@@ -62,43 +62,44 @@
 75,204,27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,
 37,249,22,148,4,80,158,39,36,27,248,22,155,4,248,22,74,197,28,249,22,
 140,9,62,61,62,248,22,149,4,248,22,98,196,250,22,83,2,22,248,22,83,
-249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,5,249,22,83,2,27,
+249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,4,249,22,83,2,27,
 249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,83,2,18,28,249,22,
 140,9,248,22,149,4,248,22,74,200,64,101,108,115,101,10,248,22,74,197,250,
-22,84,2,22,9,248,22,75,200,249,22,73,2,5,248,22,75,202,99,13,16,
+22,84,2,22,9,248,22,75,200,249,22,73,2,4,248,22,75,202,99,13,16,
 5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,
-20,3,1,8,101,110,118,49,52,56,51,53,16,4,11,11,2,21,3,1,8,
-101,110,118,49,52,56,51,54,18,158,94,10,64,118,111,105,100,8,48,27,248,
+20,3,1,8,101,110,118,49,52,55,54,53,16,4,11,11,2,21,3,1,8,
+101,110,118,49,52,55,54,54,18,158,94,10,64,118,111,105,100,8,48,27,248,
 22,75,248,22,155,4,196,249,22,148,4,80,158,39,36,28,248,22,58,248,22,
 149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199,248,22,98,
 198,27,248,22,149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,
 197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,112,159,36,16,
-1,11,16,0,20,26,142,2,1,2,1,2,2,11,11,11,10,36,80,158,36,
-36,20,112,159,36,16,0,16,0,16,1,2,3,37,16,0,36,16,0,36,11,
-11,39,36,11,11,16,10,2,4,2,5,2,6,2,7,2,8,2,9,2,10,
-2,11,2,12,2,13,16,10,11,11,11,11,11,11,11,11,11,11,16,10,2,
-4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,36,46,
-37,11,11,16,0,16,0,16,0,36,36,11,11,11,16,0,16,0,16,0,36,
-36,16,11,16,5,2,3,20,14,159,36,36,36,36,20,112,159,36,16,0,16,
-1,33,33,10,16,5,2,6,88,163,8,36,37,53,37,9,223,0,33,34,36,
-20,112,159,36,16,1,2,3,16,0,11,16,5,2,9,88,163,8,36,37,53,
-37,9,223,0,33,35,36,20,112,159,36,16,1,2,3,16,0,11,16,5,2,
-11,88,163,8,36,37,53,37,9,223,0,33,36,36,20,112,159,36,16,1,2,
-3,16,1,33,37,11,16,5,2,13,88,163,8,36,37,56,37,9,223,0,33,
-38,36,20,112,159,36,16,1,2,3,16,1,33,39,11,16,5,2,4,88,163,
-8,36,37,58,37,9,223,0,33,42,36,20,112,159,36,16,1,2,3,16,0,
-11,16,5,2,12,88,163,8,36,37,53,37,9,223,0,33,44,36,20,112,159,
-36,16,1,2,3,16,0,11,16,5,2,10,88,163,8,36,37,54,37,9,223,
-0,33,45,36,20,112,159,36,16,1,2,3,16,0,11,16,5,2,7,88,163,
-8,36,37,56,37,9,223,0,33,46,36,20,112,159,36,16,1,2,3,16,0,
-11,16,5,2,5,88,163,8,36,37,58,37,9,223,0,33,47,36,20,112,159,
-36,16,1,2,3,16,1,33,49,11,16,5,2,8,88,163,8,36,37,54,37,
-9,223,0,33,50,36,20,112,159,36,16,1,2,3,16,0,11,16,0,94,2,
-16,2,17,93,2,16,9,9,36,0};
-    EVAL_ONE_SIZED_STR((char *)expr, 2004);
+1,11,16,0,20,26,146,2,1,2,1,2,2,11,11,11,10,36,80,158,36,
+36,20,112,159,36,16,0,16,0,38,39,36,16,0,36,16,0,36,11,11,11,
+16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,
+12,16,10,11,11,11,11,11,11,11,11,11,11,16,10,2,3,2,4,2,5,
+2,6,2,7,2,8,2,9,2,10,2,11,2,12,36,46,37,16,0,36,16,
+1,2,13,37,11,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,
+16,0,16,0,36,36,16,11,16,5,11,20,15,16,2,20,14,159,36,36,37,
+80,158,36,36,36,20,112,159,36,16,1,2,13,16,1,33,33,10,16,5,2,
+5,88,163,8,36,37,53,37,9,223,0,33,34,36,20,112,159,36,16,1,2,
+13,16,0,11,16,5,2,8,88,163,8,36,37,53,37,9,223,0,33,35,36,
+20,112,159,36,16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,53,
+37,9,223,0,33,36,36,20,112,159,36,16,1,2,13,16,1,33,37,11,16,
+5,2,12,88,163,8,36,37,56,37,9,223,0,33,38,36,20,112,159,36,16,
+1,2,13,16,1,33,39,11,16,5,2,3,88,163,8,36,37,58,37,9,223,
+0,33,42,36,20,112,159,36,16,1,2,13,16,0,11,16,5,2,11,88,163,
+8,36,37,53,37,9,223,0,33,44,36,20,112,159,36,16,1,2,13,16,0,
+11,16,5,2,9,88,163,8,36,37,54,37,9,223,0,33,45,36,20,112,159,
+36,16,1,2,13,16,0,11,16,5,2,6,88,163,8,36,37,56,37,9,223,
+0,33,46,36,20,112,159,36,16,1,2,13,16,0,11,16,5,2,4,88,163,
+8,36,37,58,37,9,223,0,33,47,36,20,112,159,36,16,1,2,13,16,1,
+33,49,11,16,5,2,7,88,163,8,36,37,54,37,9,223,0,33,50,36,20,
+112,159,36,16,1,2,13,16,0,11,16,0,94,2,16,2,17,93,2,16,9,
+9,36,0};
+    EVAL_ONE_SIZED_STR((char *)expr, 2018);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0,26,
 0,43,0,65,0,94,0,109,0,127,0,143,0,157,0,179,0,195,0,212,0,
 234,0,245,0,251,0,4,1,11,1,18,1,30,1,46,1,70,1,102,1,120,
@@ -110,7 +111,7 @@
 15,17,23,17,129,17,192,17,194,17,50,18,110,18,115,18,238,18,249,18,129,
 19,139,19,62,21,84,21,93,21,86,22,104,22,118,22,77,23,96,23,34,26,
 154,30,68,31,213,31,198,32,180,33,187,33,12,34,95,34,180,34,206,34,79,
-35,0,0,180,39,0,0,67,35,37,117,116,105,108,115,72,112,97,116,104,45,
+35,0,0,177,39,0,0,67,35,37,117,116,105,108,115,72,112,97,116,104,45,
 115,116,114,105,110,103,63,64,98,115,98,115,76,110,111,114,109,97,108,45,99,
 97,115,101,45,112,97,116,104,1,20,102,105,110,100,45,101,120,101,99,117,116,
 97,98,108,101,45,112,97,116,104,1,27,112,97,116,104,45,108,105,115,116,45,
@@ -369,7 +370,7 @@
 22,157,2,195,88,163,8,36,38,48,11,9,223,3,33,88,28,197,86,94,20,
 18,159,11,80,158,42,47,193,20,18,159,11,80,158,42,48,196,86,94,20,18,
 159,11,80,158,42,53,193,20,18,159,11,80,158,42,54,196,193,28,193,80,158,
-38,47,80,158,38,53,248,22,8,88,163,8,32,37,8,40,8,240,0,188,23,
+38,47,80,158,38,53,248,22,9,88,163,8,32,37,8,40,8,240,0,188,23,
 0,9,224,1,2,33,89,0,7,35,114,120,34,47,43,34,28,248,22,130,7,
 23,195,2,27,249,22,138,15,2,91,196,28,192,28,249,22,184,3,248,22,97,
 195,248,22,174,3,248,22,133,7,198,249,22,7,250,22,152,7,199,36,248,22,
@@ -541,7 +542,7 @@
 28,23,194,2,23,194,1,86,94,23,194,1,36,249,22,185,5,23,199,1,20,
 20,95,88,163,8,36,36,48,11,9,224,4,2,33,107,23,195,1,23,197,1,
 27,248,22,170,5,23,195,1,248,80,159,39,8,31,39,193,159,36,20,112,159,
-36,16,1,11,16,0,20,26,142,2,1,2,1,29,11,11,11,11,11,10,43,
+36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,11,11,11,10,43,
 80,158,36,36,20,112,159,40,16,28,2,2,2,3,2,4,2,5,2,6,2,
 7,2,8,2,9,2,10,2,11,2,12,2,13,2,14,2,15,30,2,18,76,
 102,105,110,100,45,108,105,110,107,115,45,112,97,116,104,33,4,30,2,19,1,
@@ -549,58 +550,58 @@
 6,30,2,19,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,
 114,105,122,97,116,105,111,110,3,2,20,2,21,2,22,30,2,18,1,21,101,
 120,99,101,112,116,105,111,110,45,104,97,110,100,108,101,114,45,107,101,121,2,
-2,23,2,24,2,25,2,26,2,27,2,28,2,29,16,0,16,0,36,16,0,
+2,23,2,24,2,25,2,26,2,27,2,28,2,29,16,0,37,39,36,16,0,
 36,16,12,2,8,2,7,2,3,2,24,2,22,2,20,2,15,2,21,2,23,
-2,13,2,12,2,14,48,11,11,39,36,11,11,16,12,2,11,2,9,2,29,
-2,10,2,5,2,28,2,27,2,4,2,26,2,6,2,25,2,2,16,12,11,
-11,11,11,11,11,11,11,11,11,11,11,16,12,2,11,2,9,2,29,2,10,
-2,5,2,28,2,27,2,4,2,26,2,6,2,25,2,2,48,48,37,11,11,
-16,0,16,0,16,0,36,36,11,11,11,16,0,16,0,16,0,36,36,16,0,
-16,28,20,15,16,2,88,163,8,36,37,51,16,2,8,240,0,128,0,0,8,
-240,1,128,0,0,2,30,223,0,33,50,80,159,36,8,31,39,20,15,16,2,
-88,163,8,36,37,56,16,2,44,8,240,0,64,0,0,2,30,223,0,33,51,
-80,159,36,8,30,39,20,15,16,2,88,163,8,36,37,51,16,2,44,8,128,
-128,2,30,223,0,33,52,80,159,36,8,29,39,20,15,16,2,88,163,8,36,
-37,51,16,2,44,8,128,64,2,30,223,0,33,53,80,159,36,8,28,39,20,
-15,16,2,32,0,88,163,36,37,45,11,2,2,222,33,54,80,159,36,36,37,
-20,15,16,2,249,22,132,7,7,92,7,92,80,159,36,37,37,20,15,16,2,
-88,163,36,37,54,38,2,4,223,0,33,55,80,159,36,38,37,20,15,16,2,
-20,25,96,2,5,88,163,8,36,39,8,24,52,9,223,0,33,62,88,163,36,
-38,47,44,9,223,0,33,63,88,163,36,37,46,44,9,223,0,33,64,80,159,
-36,39,37,20,15,16,2,27,248,22,132,15,248,22,144,8,27,28,249,22,140,
-9,247,22,152,8,2,32,6,1,1,59,6,1,1,58,250,22,178,7,6,14,
-14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,
-88,163,8,36,38,48,11,2,6,223,0,33,68,80,159,36,40,37,20,15,16,
-2,32,0,88,163,8,36,38,50,11,2,7,222,33,69,80,159,36,41,37,20,
-15,16,2,32,0,88,163,8,36,39,51,11,2,8,222,33,71,80,159,36,42,
-37,20,15,16,2,88,163,45,38,51,8,128,4,2,9,223,0,33,74,80,159,
-36,43,37,20,15,16,2,88,163,45,39,52,8,128,4,2,11,223,0,33,77,
-80,159,36,45,37,20,15,16,2,248,22,188,14,70,108,105,110,107,115,45,102,
-105,108,101,80,159,36,46,37,20,15,16,2,247,22,133,2,80,158,36,47,20,
-15,16,2,2,78,80,158,36,48,20,15,16,2,248,80,159,37,50,37,88,163,
-36,36,49,8,240,8,128,1,0,9,223,1,33,79,80,159,36,49,37,20,15,
-16,2,247,22,133,2,80,158,36,53,20,15,16,2,2,78,80,158,36,54,20,
-15,16,2,88,163,36,37,44,8,240,0,188,23,0,2,22,223,0,33,90,80,
-159,36,55,37,20,15,16,2,88,163,36,38,56,8,240,0,0,32,0,2,23,
-223,0,33,92,80,159,36,57,37,20,15,16,2,88,163,36,41,8,24,8,240,
-0,32,40,0,2,10,223,0,33,99,80,159,36,44,37,20,15,16,2,32,0,
-88,163,36,39,50,11,2,24,222,33,100,80,159,36,58,37,20,15,16,2,32,
-0,88,163,36,38,53,11,2,25,222,33,101,80,159,36,59,37,20,15,16,2,
-32,0,88,163,36,38,54,11,2,26,222,33,102,80,159,36,8,24,37,20,15,
-16,2,32,0,88,163,36,37,44,11,2,27,222,33,103,80,159,36,8,25,37,
-20,15,16,2,20,25,96,2,28,88,163,36,36,53,16,2,52,8,128,64,9,
-223,0,33,104,88,163,36,37,54,16,2,52,8,128,128,9,223,0,33,105,88,
-163,36,38,55,16,2,52,8,240,0,64,0,0,9,223,0,33,106,80,159,36,
-8,26,37,20,15,16,2,88,163,8,36,39,54,16,2,44,8,240,0,128,0,
-0,2,29,223,0,33,108,80,159,36,8,27,37,95,29,94,2,16,68,35,37,
-107,101,114,110,101,108,11,29,94,2,16,69,35,37,109,105,110,45,115,116,120,
-11,2,18,9,9,9,36,0};
-    EVAL_ONE_SIZED_STR((char *)expr, 10423);
+2,13,2,12,2,14,48,11,11,11,16,12,2,11,2,9,2,29,2,10,2,
+5,2,28,2,27,2,4,2,26,2,6,2,25,2,2,16,12,11,11,11,11,
+11,11,11,11,11,11,11,11,16,12,2,11,2,9,2,29,2,10,2,5,2,
+28,2,27,2,4,2,26,2,6,2,25,2,2,48,48,37,12,11,11,16,0,
+16,0,16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,28,20,
+15,16,2,88,163,8,36,37,51,16,2,8,240,0,128,0,0,8,240,1,128,
+0,0,2,30,223,0,33,50,80,159,36,8,31,39,20,15,16,2,88,163,8,
+36,37,56,16,2,44,8,240,0,64,0,0,2,30,223,0,33,51,80,159,36,
+8,30,39,20,15,16,2,88,163,8,36,37,51,16,2,44,8,128,128,2,30,
+223,0,33,52,80,159,36,8,29,39,20,15,16,2,88,163,8,36,37,51,16,
+2,44,8,128,64,2,30,223,0,33,53,80,159,36,8,28,39,20,15,16,2,
+32,0,88,163,36,37,45,11,2,2,222,33,54,80,159,36,36,37,20,15,16,
+2,249,22,132,7,7,92,7,92,80,159,36,37,37,20,15,16,2,88,163,36,
+37,54,38,2,4,223,0,33,55,80,159,36,38,37,20,15,16,2,20,25,96,
+2,5,88,163,8,36,39,8,24,52,9,223,0,33,62,88,163,36,38,47,44,
+9,223,0,33,63,88,163,36,37,46,44,9,223,0,33,64,80,159,36,39,37,
+20,15,16,2,27,248,22,132,15,248,22,144,8,27,28,249,22,140,9,247,22,
+152,8,2,32,6,1,1,59,6,1,1,58,250,22,178,7,6,14,14,40,91,
+94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,88,163,8,
+36,38,48,11,2,6,223,0,33,68,80,159,36,40,37,20,15,16,2,32,0,
+88,163,8,36,38,50,11,2,7,222,33,69,80,159,36,41,37,20,15,16,2,
+32,0,88,163,8,36,39,51,11,2,8,222,33,71,80,159,36,42,37,20,15,
+16,2,88,163,45,38,51,8,128,4,2,9,223,0,33,74,80,159,36,43,37,
+20,15,16,2,88,163,45,39,52,8,128,4,2,11,223,0,33,77,80,159,36,
+45,37,20,15,16,2,248,22,188,14,70,108,105,110,107,115,45,102,105,108,101,
+80,159,36,46,37,20,15,16,2,247,22,133,2,80,158,36,47,20,15,16,2,
+2,78,80,158,36,48,20,15,16,2,248,80,159,37,50,37,88,163,36,36,49,
+8,240,8,128,1,0,9,223,1,33,79,80,159,36,49,37,20,15,16,2,247,
+22,133,2,80,158,36,53,20,15,16,2,2,78,80,158,36,54,20,15,16,2,
+88,163,36,37,44,8,240,0,188,23,0,2,22,223,0,33,90,80,159,36,55,
+37,20,15,16,2,88,163,36,38,56,8,240,0,0,32,0,2,23,223,0,33,
+92,80,159,36,57,37,20,15,16,2,88,163,36,41,8,24,8,240,0,32,40,
+0,2,10,223,0,33,99,80,159,36,44,37,20,15,16,2,32,0,88,163,36,
+39,50,11,2,24,222,33,100,80,159,36,58,37,20,15,16,2,32,0,88,163,
+36,38,53,11,2,25,222,33,101,80,159,36,59,37,20,15,16,2,32,0,88,
+163,36,38,54,11,2,26,222,33,102,80,159,36,8,24,37,20,15,16,2,32,
+0,88,163,36,37,44,11,2,27,222,33,103,80,159,36,8,25,37,20,15,16,
+2,20,25,96,2,28,88,163,36,36,53,16,2,52,8,128,64,9,223,0,33,
+104,88,163,36,37,54,16,2,52,8,128,128,9,223,0,33,105,88,163,36,38,
+55,16,2,52,8,240,0,64,0,0,9,223,0,33,106,80,159,36,8,26,37,
+20,15,16,2,88,163,8,36,39,54,16,2,44,8,240,0,128,0,0,2,29,
+223,0,33,108,80,159,36,8,27,37,95,29,94,2,16,68,35,37,107,101,114,
+110,101,108,11,29,94,2,16,69,35,37,109,105,110,45,115,116,120,11,2,18,
+9,9,9,36,0};
+    EVAL_ONE_SIZED_STR((char *)expr, 10420);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,57,
-0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,178,1,
+0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,175,1,
 0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,116,
 114,117,99,116,58,84,72,45,112,108,97,99,101,45,99,104,97,110,110,101,108,
 76,84,72,45,112,108,97,99,101,45,99,104,97,110,110,101,108,77,84,72,45,
@@ -610,29 +611,29 @@
 112,108,97,99,101,45,99,104,97,110,110,101,108,45,105,110,1,20,84,72,45,
 112,108,97,99,101,45,99,104,97,110,110,101,108,45,111,117,116,249,80,158,38,
 39,195,36,249,80,158,38,39,195,36,249,80,158,38,39,195,37,159,36,20,112,
-159,36,16,1,11,16,0,20,26,142,2,1,2,1,29,11,11,11,11,11,10,
+159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,11,11,11,10,
 45,80,158,36,36,20,112,159,36,16,7,2,2,2,3,2,4,2,5,2,6,
-2,7,2,8,16,0,16,0,36,16,0,36,16,2,2,5,2,6,38,11,11,
-39,36,11,11,16,5,2,3,2,7,2,8,2,4,2,2,16,5,11,11,11,
-11,11,16,5,2,3,2,7,2,8,2,4,2,2,41,41,37,11,11,16,0,
-16,0,16,0,36,36,11,11,11,16,0,16,0,16,0,36,36,16,0,16,2,
-20,15,16,6,253,22,176,10,2,3,11,38,36,11,248,22,83,249,22,73,22,
-164,10,88,163,36,37,45,44,9,223,9,33,9,80,159,36,36,37,80,159,36,
-37,37,80,159,36,38,37,80,159,36,39,37,80,159,36,40,37,20,15,16,3,
-249,22,7,88,163,36,37,45,44,9,223,2,33,10,88,163,36,37,45,44,9,
-223,2,33,11,80,159,36,41,37,80,159,36,42,37,93,29,94,65,113,117,111,
-116,101,68,35,37,107,101,114,110,101,108,11,9,9,9,36,0};
-    EVAL_ONE_SIZED_STR((char *)expr, 499);
+2,7,2,8,16,0,37,39,36,16,0,36,16,2,2,5,2,6,38,11,11,
+11,16,5,2,3,2,7,2,8,2,4,2,2,16,5,11,11,11,11,11,16,
+5,2,3,2,7,2,8,2,4,2,2,41,41,37,12,11,11,16,0,16,0,
+16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,2,20,15,16,
+6,253,22,176,10,2,3,11,38,36,11,248,22,83,249,22,73,22,164,10,88,
+163,36,37,45,44,9,223,9,33,9,80,159,36,36,37,80,159,36,37,37,80,
+159,36,38,37,80,159,36,39,37,80,159,36,40,37,20,15,16,3,249,22,7,
+88,163,36,37,45,44,9,223,2,33,10,88,163,36,37,45,44,9,223,2,33,
+11,80,159,36,41,37,80,159,36,42,37,93,29,94,65,113,117,111,116,101,68,
+35,37,107,101,114,110,101,108,11,9,9,9,36,0};
+    EVAL_ONE_SIZED_STR((char *)expr, 496);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,65,0,0,0,1,0,0,7,0,18,0,45,
 0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,0,
 201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,94,
 1,99,1,104,1,109,1,118,1,123,1,127,1,135,1,144,1,152,1,213,1,
 60,2,81,2,102,2,132,2,162,2,220,2,22,3,71,3,120,3,54,9,105,
 9,168,9,187,9,201,9,103,10,116,10,250,10,36,12,159,12,165,12,179,12,
-206,12,226,12,30,13,117,13,119,13,188,13,16,20,69,20,93,20,0,0,185,
+206,12,226,12,30,13,117,13,119,13,188,13,16,20,69,20,93,20,0,0,182,
 23,0,0,66,35,37,98,111,111,116,70,100,108,108,45,115,117,102,102,105,120,
 1,25,100,101,102,97,117,108,116,45,108,111,97,100,47,117,115,101,45,99,111,
 109,112,105,108,101,100,65,113,117,111,116,101,29,94,2,4,67,35,37,117,116,
@@ -882,7 +883,7 @@
 22,178,4,80,159,37,54,38,248,22,158,5,80,159,37,37,39,248,22,181,13,
 80,159,37,42,39,20,18,159,11,80,158,36,53,248,80,159,37,8,25,37,249,
 22,27,11,80,159,39,55,37,159,36,20,112,159,36,16,1,11,16,0,20,26,
-142,2,1,2,1,29,11,11,11,11,11,10,38,80,158,36,36,20,112,159,40,
+141,2,1,2,1,29,11,11,11,11,11,10,38,80,158,36,36,20,112,159,40,
 16,26,2,2,2,3,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,
 63,11,30,2,5,75,112,97,116,104,45,97,100,100,45,115,117,102,102,105,120,
 8,30,2,7,2,8,6,30,2,7,1,23,101,120,116,101,110,100,45,112,97,
@@ -892,59 +893,59 @@
 45,115,117,102,102,105,120,10,30,2,5,73,102,105,110,100,45,99,111,108,45,
 102,105,108,101,3,30,2,5,76,110,111,114,109,97,108,45,99,97,115,101,45,
 112,97,116,104,7,2,23,2,24,30,2,22,74,114,101,112,97,114,97,109,101,
-116,101,114,105,122,101,7,16,0,16,0,36,16,0,36,16,14,2,15,2,16,
+116,101,114,105,122,101,7,16,0,37,39,36,16,0,36,16,14,2,15,2,16,
 2,10,2,12,2,17,2,18,2,11,2,3,2,9,2,2,2,13,2,14,2,
-19,2,21,50,11,11,39,36,11,11,16,3,2,23,2,20,2,24,16,3,11,
-11,11,16,3,2,23,2,20,2,24,39,39,37,11,11,16,0,16,0,16,0,
-36,36,11,11,11,16,0,16,0,16,0,36,36,16,0,16,21,20,15,16,2,
-88,163,36,37,45,8,128,128,9,223,0,33,32,80,159,36,8,29,39,20,15,
-16,2,88,163,8,36,37,45,8,240,0,0,1,0,9,223,0,33,33,80,159,
-36,8,28,39,20,15,16,2,88,163,36,37,49,8,240,0,0,16,0,72,112,
-97,116,104,45,115,115,45,62,114,107,116,223,0,33,34,80,159,36,8,27,39,
-20,15,16,2,88,163,36,37,49,8,240,0,192,0,0,67,103,101,116,45,100,
-105,114,223,0,33,35,80,159,36,8,26,39,20,15,16,2,248,22,152,8,69,
-115,111,45,115,117,102,102,105,120,80,159,36,36,37,20,15,16,2,88,163,36,
-38,8,38,8,61,2,3,223,0,33,44,80,159,36,37,37,20,15,16,2,32,
-0,88,163,8,36,37,42,11,2,9,222,192,80,159,36,42,37,20,15,16,2,
-247,22,136,2,80,159,36,43,37,20,15,16,2,8,128,8,80,159,36,44,37,
-20,15,16,2,249,22,156,8,8,128,8,11,80,159,36,45,37,20,15,16,2,
-88,163,8,36,37,50,8,128,8,2,13,223,0,33,45,80,159,36,46,37,20,
-15,16,2,88,163,8,36,38,55,8,128,8,2,14,223,0,33,46,80,159,36,
-47,37,20,15,16,2,247,22,69,80,159,36,48,37,20,15,16,2,248,22,18,
-74,109,111,100,117,108,101,45,108,111,97,100,105,110,103,80,159,36,49,37,20,
-15,16,2,11,80,158,36,50,20,15,16,2,11,80,158,36,51,20,15,16,2,
-32,0,88,163,36,38,8,25,11,2,19,222,33,52,80,159,36,52,37,20,15,
-16,2,11,80,158,36,53,20,15,16,2,27,11,20,19,158,36,90,159,37,10,
-89,161,37,36,10,20,25,96,2,21,88,163,8,36,37,51,8,128,2,9,224,
-2,1,33,53,88,163,36,39,49,11,9,223,0,33,54,88,163,36,40,8,38,
-16,2,8,176,218,8,187,241,9,224,2,1,33,62,207,80,159,36,54,37,20,
-15,16,2,88,163,36,36,45,8,240,66,0,14,2,2,23,223,0,33,63,80,
-159,36,59,37,20,15,16,2,88,163,8,36,36,45,8,240,0,0,10,2,2,
-24,223,0,33,64,80,159,36,8,24,37,96,29,94,2,4,68,35,37,107,101,
-114,110,101,108,11,29,94,2,4,69,35,37,109,105,110,45,115,116,120,11,2,
-5,2,22,9,9,9,36,0};
-    EVAL_ONE_SIZED_STR((char *)expr, 6244);
+19,2,21,50,11,11,11,16,3,2,23,2,20,2,24,16,3,11,11,11,16,
+3,2,23,2,20,2,24,39,39,37,12,11,11,16,0,16,0,16,0,36,36,
+11,12,11,11,16,0,16,0,16,0,36,36,16,21,20,15,16,2,88,163,36,
+37,45,8,128,128,9,223,0,33,32,80,159,36,8,29,39,20,15,16,2,88,
+163,8,36,37,45,8,240,0,0,1,0,9,223,0,33,33,80,159,36,8,28,
+39,20,15,16,2,88,163,36,37,49,8,240,0,0,16,0,72,112,97,116,104,
+45,115,115,45,62,114,107,116,223,0,33,34,80,159,36,8,27,39,20,15,16,
+2,88,163,36,37,49,8,240,0,192,0,0,67,103,101,116,45,100,105,114,223,
+0,33,35,80,159,36,8,26,39,20,15,16,2,248,22,152,8,69,115,111,45,
+115,117,102,102,105,120,80,159,36,36,37,20,15,16,2,88,163,36,38,8,38,
+8,61,2,3,223,0,33,44,80,159,36,37,37,20,15,16,2,32,0,88,163,
+8,36,37,42,11,2,9,222,192,80,159,36,42,37,20,15,16,2,247,22,136,
+2,80,159,36,43,37,20,15,16,2,8,128,8,80,159,36,44,37,20,15,16,
+2,249,22,156,8,8,128,8,11,80,159,36,45,37,20,15,16,2,88,163,8,
+36,37,50,8,128,8,2,13,223,0,33,45,80,159,36,46,37,20,15,16,2,
+88,163,8,36,38,55,8,128,8,2,14,223,0,33,46,80,159,36,47,37,20,
+15,16,2,247,22,69,80,159,36,48,37,20,15,16,2,248,22,18,74,109,111,
+100,117,108,101,45,108,111,97,100,105,110,103,80,159,36,49,37,20,15,16,2,
+11,80,158,36,50,20,15,16,2,11,80,158,36,51,20,15,16,2,32,0,88,
+163,36,38,8,25,11,2,19,222,33,52,80,159,36,52,37,20,15,16,2,11,
+80,158,36,53,20,15,16,2,27,11,20,19,158,36,90,159,37,10,89,161,37,
+36,10,20,25,96,2,21,88,163,8,36,37,51,8,128,2,9,224,2,1,33,
+53,88,163,36,39,49,11,9,223,0,33,54,88,163,36,40,8,38,16,2,8,
+176,218,8,187,241,9,224,2,1,33,62,207,80,159,36,54,37,20,15,16,2,
+88,163,36,36,45,8,240,66,0,14,2,2,23,223,0,33,63,80,159,36,59,
+37,20,15,16,2,88,163,8,36,36,45,8,240,0,0,10,2,2,24,223,0,
+33,64,80,159,36,8,24,37,96,29,94,2,4,68,35,37,107,101,114,110,101,
+108,11,29,94,2,4,69,35,37,109,105,110,45,115,116,120,11,2,5,2,22,
+9,9,9,36,0};
+    EVAL_ONE_SIZED_STR((char *)expr, 6241);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,29,
-0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,97,1,0,0,
+0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,94,1,0,0,
 69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,
 35,37,117,116,105,108,115,11,29,94,2,2,69,35,37,110,101,116,119,111,114,
 107,11,29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,74,
 35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,2,66,35,
 37,98,111,111,116,11,29,94,2,2,68,35,37,101,120,112,111,98,115,11,29,
-94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,56,78,0,
+94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,11,78,0,
 0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,36,
 36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,36,
-16,0,159,36,20,112,159,36,16,1,11,16,0,20,26,142,2,1,2,1,29,
+16,0,159,36,20,112,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,
 11,11,11,11,11,18,96,11,46,46,46,36,80,158,36,36,20,112,159,36,16,
-0,16,0,16,0,36,16,0,36,16,0,36,11,11,39,36,11,11,16,0,16,
-0,16,0,36,36,37,11,11,16,0,16,0,16,0,36,36,11,11,11,16,0,
-16,0,16,0,36,36,16,0,16,0,104,2,9,2,8,29,94,2,2,69,35,
-37,102,111,114,101,105,103,110,11,29,94,2,2,68,35,37,117,110,115,97,102,
-101,11,29,94,2,2,69,35,37,102,108,102,120,110,117,109,11,2,7,2,6,
-2,5,2,4,2,3,29,94,2,2,67,35,37,112,108,97,99,101,11,29,94,
-2,2,69,35,37,102,117,116,117,114,101,115,11,9,9,9,36,0};
-    EVAL_ONE_SIZED_STR((char *)expr, 416);
+0,16,0,37,39,36,16,0,36,16,0,36,11,11,11,16,0,16,0,16,0,
+36,36,37,12,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,16,
+0,16,0,36,36,16,0,104,2,9,2,8,29,94,2,2,69,35,37,102,111,
+114,101,105,103,110,11,29,94,2,2,68,35,37,117,110,115,97,102,101,11,29,
+94,2,2,69,35,37,102,108,102,120,110,117,109,11,2,7,2,6,2,5,2,
+4,2,3,29,94,2,2,67,35,37,112,108,97,99,101,11,29,94,2,2,69,
+35,37,102,117,116,117,114,101,115,11,9,9,9,36,0};
+    EVAL_ONE_SIZED_STR((char *)expr, 413);
   }
diff --git a/src/racket/src/env.c b/src/racket/src/env.c
index ae403f6eb2..2a2681b85c 100644
--- a/src/racket/src/env.c
+++ b/src/racket/src/env.c
@@ -113,7 +113,6 @@ static Scheme_Object *rename_transformer_p(int argc, Scheme_Object *argv[]);
 static void skip_certain_things(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data);
 
 Scheme_Env *scheme_engine_instance_init();
-Scheme_Env *scheme_place_instance_init();
 static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thread);
 
 #ifdef MZ_PRECISE_GC
@@ -503,20 +502,22 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
   return env;
 }
 
-Scheme_Env *scheme_place_instance_init(void *stack_base) {
+#ifdef MZ_USE_PLACES
+Scheme_Env *scheme_place_instance_init(void *stack_base, struct NewGC *parent_gc, intptr_t memory_limit) {
   Scheme_Env *env;
-#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
+# if defined(MZ_PRECISE_GC)
   int *signal_fd;
-  GC_construct_child_gc();
-#endif
+  GC_construct_child_gc(parent_gc, memory_limit);
+# endif
   env = place_instance_init(stack_base, 0);
-#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
+# if defined(MZ_PRECISE_GC)
   signal_fd = scheme_get_signal_handle();
   GC_set_put_external_event_fd(signal_fd);
-#endif
+# endif
   scheme_set_can_break(1);
   return env; 
 }
+#endif
 
 static void force_more_closed(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data)
 {
@@ -836,6 +837,7 @@ scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree
 
   scheme_prepare_label_env(env);
   menv->label_env = env->label_env;
+  menv->instance_env = env;
 
   if (new_exp_module_tree) {
     Scheme_Object *p;
@@ -887,6 +889,7 @@ void scheme_prepare_exp_env(Scheme_Env *env)
     env->exp_env = eenv;
     eenv->template_env = env;
     eenv->label_env = env->label_env;
+    eenv->instance_env = env->instance_env;
 
     scheme_prepare_env_renames(env, mzMOD_RENAME_TOPLEVEL);
     eenv->rename_set = env->rename_set;
@@ -930,6 +933,7 @@ void scheme_prepare_template_env(Scheme_Env *env)
     env->template_env = eenv;
     eenv->exp_env = env;       
     eenv->label_env = env->label_env;
+    eenv->instance_env = env->instance_env;
 
     if (env->disallow_unbound)
       eenv->disallow_unbound = env->disallow_unbound;
@@ -963,6 +967,7 @@ void scheme_prepare_label_env(Scheme_Env *env)
     lenv->exp_env = lenv;
     lenv->label_env = lenv;
     lenv->template_env = lenv;
+    lenv->instance_env = env->instance_env;
   }
 }
 
@@ -982,7 +987,9 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
   menv2->module_registry = ns->module_registry;
   menv2->insp = menv->insp;
 
-  if (menv->phase < clone_phase)
+  menv2->instance_env = menv2;
+
+  if (menv->phase < clone_phase) 
     menv2->syntax = menv->syntax;
   else {
     bucket_table = scheme_make_bucket_table(7, SCHEME_hash_ptr);
@@ -993,11 +1000,21 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
   menv2->mod_phase = menv->mod_phase;
   menv2->link_midx = menv->link_midx;
   if (menv->phase <= clone_phase) {
-    menv2->running = menv->running;
     menv2->ran = menv->ran;
   }
-  if (menv->phase < clone_phase)
-    menv2->et_running = menv->et_running;
+  if (menv->mod_phase == 0) {
+    char *running;
+    int amt;
+    running = (char *)scheme_malloc_atomic(menv->module->num_phases);
+    menv2->running = running;
+    memset(running, 0, menv->module->num_phases);
+    amt = (clone_phase - menv->phase) + 1;
+    if (amt > 0) {
+      if (amt > menv->module->num_phases)
+        amt = menv->module->num_phases;
+      memcpy(running, menv->running, amt);
+    }
+  }
 
   menv2->require_names = menv->require_names;
   menv2->et_require_names = menv->et_require_names;
@@ -2300,18 +2317,12 @@ local_module_exports(int argc, Scheme_Object *argv[])
 static Scheme_Object *
 local_module_definitions(int argc, Scheme_Object *argv[])
 {
-  Scheme_Object *a[2];
-
   if (!scheme_current_thread->current_local_env
       || !scheme_current_thread->current_local_bindings)
     scheme_raise_exn(MZEXN_FAIL_CONTRACT, 
 		     "syntax-local-module-defined-identifiers: not currently transforming module provides");
   
-  a[0] = SCHEME_CDR(scheme_current_thread->current_local_bindings);
-  a[1] = SCHEME_CDR(a[0]);
-  a[0] = SCHEME_CAR(a[0]);
-
-  return scheme_values(2, a);
+  return SCHEME_CDR(scheme_current_thread->current_local_bindings);
 }
 
 static Scheme_Object *
diff --git a/src/racket/src/error.c b/src/racket/src/error.c
index f13a9492da..087fb3ebb7 100644
--- a/src/racket/src/error.c
+++ b/src/racket/src/error.c
@@ -28,6 +28,11 @@
 #ifdef DOS_FILE_SYSTEM
 # include <windows.h>
 #endif
+#ifdef NO_ERRNO_GLOBAL
+# define errno -1
+#else
+# include <errno.h>
+#endif
 #ifdef USE_C_SYSLOG
 # include <syslog.h>
 # include <stdarg.h>
@@ -157,6 +162,14 @@ static void default_output(char *s, intptr_t len)
   fflush(stderr);
 }
 
+intptr_t scheme_errno() {
+#ifdef WINDOWS_FILE_HANDLES
+  return GetLastError();
+#else
+  return errno;
+#endif
+}
+
 Scheme_Config *scheme_init_error_escape_proc(Scheme_Config *config)
 {
   if (!def_error_esc_proc) {
diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c
index aa59ea2e20..7217d9b06f 100644
--- a/src/racket/src/eval.c
+++ b/src/racket/src/eval.c
@@ -1669,10 +1669,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
 
     save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false);
     vals = scheme_eval_linked_expr_multi_with_dynamic_state(vals_expr, dyn_state);
-    if (defmacro == 2)
-      dm_env = NULL;
-    else
-      scheme_pop_prefix(save_runstack);
+    scheme_pop_prefix(save_runstack);
   } else {
     vals = _scheme_eval_linked_expr_multi(vals_expr);
     dm_env = NULL;
@@ -1782,16 +1779,13 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
   } else
     name = NULL;
   
-  if (defmacro > 1)
-    scheme_pop_prefix(save_runstack);
-
   {
     const char *symname;
 
     symname = (show_any ? scheme_symbol_name(name) : "");
 
     scheme_wrong_return_arity((defmacro 
-			       ? (dm_env ? "define-syntaxes" : "define-values-for-syntax")
+			       ? "define-syntaxes"
 			       : "define-values"),
 			      i, g,
 			      (g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array,
@@ -2034,7 +2028,7 @@ static Scheme_Object *splice_execute(Scheme_Object *data)
   }
 }
 
-static Scheme_Object *do_define_syntaxes_execute(Scheme_Object *expr, Scheme_Env *dm_env, int for_stx);
+static Scheme_Object *do_define_syntaxes_execute(Scheme_Object *expr, Scheme_Env *dm_env);
 
 static void *define_syntaxes_execute_k(void)
 {
@@ -2043,11 +2037,11 @@ static void *define_syntaxes_execute_k(void)
   Scheme_Env *dm_env = (Scheme_Env *)p->ku.k.p2;
   p->ku.k.p1 = NULL;
   p->ku.k.p2 = NULL;
-  return do_define_syntaxes_execute(form, dm_env, p->ku.k.i1);
+  return do_define_syntaxes_execute(form, dm_env);
 }
 
 static Scheme_Object *
-do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx)
+do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env)
 {
   Scheme_Thread *p = scheme_current_thread;
   Resolve_Prefix *rp;
@@ -2068,7 +2062,6 @@ do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx)
       dm_env = scheme_environment_from_dummy(dummy);
     }
     p->ku.k.p2 = (Scheme_Object *)dm_env;
-    p->ku.k.i1 = for_stx;
 
     return (Scheme_Object *)scheme_enlarge_runstack(depth, define_syntaxes_execute_k);
   }
@@ -2095,24 +2088,40 @@ do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx)
     scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
 
     scheme_set_dynamic_state(&dyn_state, rhs_env, NULL, scheme_false, dm_env, dm_env->link_midx);
-    result = define_execute_with_dynamic_state(form, 4, for_stx ? 2 : 1, rp, dm_env, &dyn_state);
 
+    if (SAME_TYPE(SCHEME_TYPE(form), scheme_define_syntaxes_type)) {
+      result = define_execute_with_dynamic_state(form, 4, 1, rp, dm_env, &dyn_state);
+    } else {
+      Scheme_Object **save_runstack;
+
+      form = SCHEME_VEC_ELS(form)[0];
+
+      save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false);
+
+      while (!SCHEME_NULLP(form)) {
+        (void)scheme_eval_linked_expr_multi_with_dynamic_state(SCHEME_CAR(form), &dyn_state);
+        form = SCHEME_CDR(form);
+      }
+      
+      scheme_pop_prefix(save_runstack);
+    }
+    
     scheme_pop_continuation_frame(&cframe);
 
-    return result;
+    return scheme_void;
   }
 }
 
 static Scheme_Object *
 define_syntaxes_execute(Scheme_Object *form)
 {
-  return do_define_syntaxes_execute(form, NULL, 0);
+  return do_define_syntaxes_execute(form, NULL);
 }
 
 static Scheme_Object *
-define_for_syntaxes_execute(Scheme_Object *form)
+begin_for_syntax_execute(Scheme_Object *form)
 {
-  return do_define_syntaxes_execute(form, NULL, 1);
+  return do_define_syntaxes_execute(form, NULL);
 }
 
 /*========================================================================*/
@@ -3444,10 +3453,10 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
           v = define_syntaxes_execute(obj);
           break;
         }
-      case scheme_define_for_syntax_type:
+      case scheme_begin_for_syntax_type:
         {
           UPDATE_THREAD_RSPTR();
-          v = define_for_syntaxes_execute(obj);
+          v = begin_for_syntax_execute(obj);
           break;
         }
       case scheme_set_bang_type:
@@ -5179,7 +5188,7 @@ Scheme_Object *scheme_eval_clone(Scheme_Object *expr)
     return scheme_module_eval_clone(expr);
     break;
   case scheme_define_syntaxes_type:
-  case scheme_define_for_syntax_type:
+  case scheme_begin_for_syntax_type:
     return scheme_syntaxes_eval_clone(expr);
   default:
     return expr;
diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c
index 37f6b37087..a22dd19585 100644
--- a/src/racket/src/fun.c
+++ b/src/racket/src/fun.c
@@ -119,7 +119,7 @@ THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_stx);
 THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_beg_stx);
 THREAD_LOCAL_DECL(static Scheme_Object *cached_dv_stx);
 THREAD_LOCAL_DECL(static Scheme_Object *cached_ds_stx);
-THREAD_LOCAL_DECL(static Scheme_Object *cached_dvs_stx);
+THREAD_LOCAL_DECL(static Scheme_Object *cached_bfs_stx);
 THREAD_LOCAL_DECL(static int cached_stx_phase);
 THREAD_LOCAL_DECL(static Scheme_Cont *offstack_cont);
 THREAD_LOCAL_DECL(static Scheme_Overflow *offstack_overflow);
@@ -624,7 +624,7 @@ scheme_init_fun_places()
   REGISTER_SO(cached_mod_beg_stx);
   REGISTER_SO(cached_dv_stx);
   REGISTER_SO(cached_ds_stx);
-  REGISTER_SO(cached_dvs_stx);
+  REGISTER_SO(cached_bfs_stx);
   REGISTER_SO(offstack_cont);
   REGISTER_SO(offstack_overflow);
 }
@@ -1550,7 +1550,7 @@ cert_with_specials(Scheme_Object *code,
 /* Arms (insp) or re-arms (old_stx) taints. */
 {
   Scheme_Object *prop;
-  int next_cadr_deflt = 0;
+  int next_cadr_deflt = 0, phase_delta = 0;
 
 #ifdef DO_STACK_CHECK
   {
@@ -1609,7 +1609,7 @@ cert_with_specials(Scheme_Object *code,
         name = scheme_stx_taint_disarm(code, NULL);
         name = SCHEME_STX_CAR(name);
 	if (SCHEME_STX_SYMBOLP(name)) {
-	  Scheme_Object *beg_stx, *mod_stx, *mod_beg_stx, *dv_stx, *ds_stx, *dvs_stx;
+	  Scheme_Object *beg_stx, *mod_stx, *mod_beg_stx, *dv_stx, *ds_stx, *bfs_stx;
 
 	  if (!phase) {
             mod_stx = scheme_module_stx;
@@ -1617,14 +1617,14 @@ cert_with_specials(Scheme_Object *code,
 	    mod_beg_stx = scheme_module_begin_stx;
 	    dv_stx = scheme_define_values_stx;
 	    ds_stx = scheme_define_syntaxes_stx;
-	    dvs_stx = scheme_define_for_syntaxes_stx;
+	    bfs_stx = scheme_begin_for_syntax_stx;
 	  } else if (phase == cached_stx_phase) {
 	    beg_stx = cached_beg_stx;
 	    mod_stx = cached_mod_stx;
 	    mod_beg_stx = cached_mod_beg_stx;
 	    dv_stx = cached_dv_stx;
 	    ds_stx = cached_ds_stx;
-	    dvs_stx = cached_dvs_stx;
+	    bfs_stx = cached_bfs_stx;
 	  } else {
             Scheme_Object *sr;
             sr = scheme_sys_wraps_phase(scheme_make_integer(phase));
@@ -1638,14 +1638,14 @@ cert_with_specials(Scheme_Object *code,
 					    sr, 0, 0);
 	    ds_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_syntaxes_stx), scheme_false, 
 					    sr, 0, 0);
-	    dvs_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_for_syntaxes_stx), scheme_false, 
+	    bfs_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_begin_for_syntax_stx), scheme_false, 
                                              sr, 0, 0);
 	    cached_beg_stx = beg_stx;
 	    cached_mod_stx = mod_stx;
 	    cached_mod_beg_stx = mod_beg_stx;
 	    cached_dv_stx = dv_stx;
 	    cached_ds_stx = ds_stx;
-	    cached_dvs_stx = dvs_stx;
+	    cached_bfs_stx = bfs_stx;
 	    cached_stx_phase = phase;
 	  }
 
@@ -1654,9 +1654,12 @@ cert_with_specials(Scheme_Object *code,
               || scheme_stx_module_eq(mod_beg_stx, name, phase)) {
 	    trans = 1;
 	    next_cadr_deflt = 0;
+	  } else if (scheme_stx_module_eq(bfs_stx, name, phase)) {
+	    trans = 1;
+	    next_cadr_deflt = 0;
+            phase_delta = 1;
 	  } else if (scheme_stx_module_eq(dv_stx, name, phase)
-		     || scheme_stx_module_eq(ds_stx, name, phase)
-		     || scheme_stx_module_eq(dvs_stx, name, phase)) {
+		     || scheme_stx_module_eq(ds_stx, name, phase)) {
 	    trans = 1;
 	    next_cadr_deflt = 1;
 	  }
@@ -1676,9 +1679,9 @@ cert_with_specials(Scheme_Object *code,
     Scheme_Object *a, *d, *v;
     
     a = SCHEME_STX_CAR(code);
-    a = cert_with_specials(a, insp, old_stx, phase, cadr_deflt, 0);
+    a = cert_with_specials(a, insp, old_stx, phase + phase_delta, cadr_deflt, 0);
     d = SCHEME_STX_CDR(code);
-    d = cert_with_specials(d, insp, old_stx, phase, 1, next_cadr_deflt);
+    d = cert_with_specials(d, insp, old_stx, phase + phase_delta, 1, next_cadr_deflt);
 
     v = scheme_make_pair(a, d);
 
diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c
index 77ae9e551c..239a5f3b09 100644
--- a/src/racket/src/jit.c
+++ b/src/racket/src/jit.c
@@ -2364,7 +2364,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
   case scheme_splice_sequence_type:
   case scheme_define_values_type:
   case scheme_define_syntaxes_type:
-  case scheme_define_for_syntax_type:
+  case scheme_begin_for_syntax_type:
   case scheme_require_form_type:
   case scheme_module_type:
     {
diff --git a/src/racket/src/jitprep.c b/src/racket/src/jitprep.c
index 594e6ca729..a335ae94d9 100644
--- a/src/racket/src/jitprep.c
+++ b/src/racket/src/jitprep.c
@@ -483,7 +483,7 @@ static Scheme_Object *define_syntaxes_jit(Scheme_Object *expr)
   return do_define_syntaxes_clone(expr, 1);
 }
 
-static Scheme_Object *define_for_syntaxes_jit(Scheme_Object *expr)
+static Scheme_Object *begin_for_syntax_jit(Scheme_Object *expr)
 {
   return do_define_syntaxes_clone(expr, 1);
 }
@@ -583,8 +583,8 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
     return define_values_jit(expr);
   case scheme_define_syntaxes_type:
     return define_syntaxes_jit(expr);
-  case scheme_define_for_syntax_type:
-    return define_for_syntaxes_jit(expr);
+  case scheme_begin_for_syntax_type:
+    return begin_for_syntax_jit(expr);
   case scheme_set_bang_type:
     return set_jit(expr);
   case scheme_boxenv_type:
@@ -622,9 +622,26 @@ static Scheme_Object *do_define_syntaxes_clone(Scheme_Object *expr, int jit)
   
   rhs = SCHEME_VEC_ELS(expr)[0];
 #ifdef MZ_USE_JIT
-  if (jit)
-    naya = scheme_jit_expr(rhs);
-  else
+  if (jit) {
+    if (SAME_TYPE(SCHEME_TYPE(expr), scheme_define_syntaxes_type))
+      naya = scheme_jit_expr(rhs);
+    else {
+      int changed = 0;
+      Scheme_Object *a, *l = rhs;
+      naya = scheme_null;
+      while (!SCHEME_NULLP(l)) {
+        a = scheme_jit_expr(SCHEME_CAR(l));
+        if (!SAME_OBJ(a, SCHEME_CAR(l)))
+          changed = 1;
+        naya = scheme_make_pair(a, naya);
+        l = SCHEME_CDR(l);
+      }
+      if (changed)
+        naya = scheme_reverse(naya);
+      else
+        naya = rhs;
+    }
+  } else
 #endif
     naya = rhs;
 
diff --git a/src/racket/src/marshal.c b/src/racket/src/marshal.c
index e042ffcdb9..c389cbe8d7 100644
--- a/src/racket/src/marshal.c
+++ b/src/racket/src/marshal.c
@@ -45,8 +45,8 @@ static Scheme_Object *read_define_values(Scheme_Object *obj);
 static Scheme_Object *write_define_values(Scheme_Object *obj);
 static Scheme_Object *read_define_syntaxes(Scheme_Object *obj);
 static Scheme_Object *write_define_syntaxes(Scheme_Object *obj);
-static Scheme_Object *read_define_for_syntax(Scheme_Object *obj);
-static Scheme_Object *write_define_for_syntax(Scheme_Object *obj);
+static Scheme_Object *read_begin_for_syntax(Scheme_Object *obj);
+static Scheme_Object *write_begin_for_syntax(Scheme_Object *obj);
 static Scheme_Object *read_set_bang(Scheme_Object *obj);
 static Scheme_Object *write_set_bang(Scheme_Object *obj);
 static Scheme_Object *read_boxenv(Scheme_Object *obj);
@@ -125,8 +125,8 @@ void scheme_init_marshal(Scheme_Env *env)
   scheme_install_type_reader(scheme_define_values_type, read_define_values);
   scheme_install_type_writer(scheme_define_syntaxes_type, write_define_syntaxes);
   scheme_install_type_reader(scheme_define_syntaxes_type, read_define_syntaxes);
-  scheme_install_type_writer(scheme_define_for_syntax_type, write_define_for_syntax);
-  scheme_install_type_reader(scheme_define_for_syntax_type, read_define_for_syntax);
+  scheme_install_type_writer(scheme_begin_for_syntax_type, write_begin_for_syntax);
+  scheme_install_type_reader(scheme_begin_for_syntax_type, read_begin_for_syntax);
   scheme_install_type_writer(scheme_set_bang_type, write_set_bang);
   scheme_install_type_reader(scheme_set_bang_type, read_set_bang);
   scheme_install_type_writer(scheme_boxenv_type, write_boxenv);
@@ -407,16 +407,16 @@ static Scheme_Object *write_define_syntaxes(Scheme_Object *obj)
   return write_define_values(obj);
 }
 
-static Scheme_Object *read_define_for_syntax(Scheme_Object *obj)
+static Scheme_Object *read_begin_for_syntax(Scheme_Object *obj)
 {
   if (!SCHEME_VECTORP(obj)) return NULL;
 
   obj = scheme_clone_vector(obj, 0, 0);
-  obj->type = scheme_define_for_syntax_type;
+  obj->type = scheme_begin_for_syntax_type;
   return obj;
 }
 
-static Scheme_Object *write_define_for_syntax(Scheme_Object *obj)
+static Scheme_Object *write_begin_for_syntax(Scheme_Object *obj)
 {
   return write_define_values(obj);
 }
@@ -1125,8 +1125,8 @@ static Scheme_Object *write_module(Scheme_Object *obj)
 {
   Scheme_Module *m = (Scheme_Module *)obj;
   Scheme_Module_Phase_Exports *pt;
-  Scheme_Object *l, *v;
-  int i, k, count, cnt;
+  Scheme_Object *l, *v, *phase;
+  int i, j, k, count, cnt;
 
   l = scheme_null;
   cnt = 0;
@@ -1147,22 +1147,27 @@ static Scheme_Object *write_module(Scheme_Object *obj)
   l = cons(m->et_requires, l);
   l = cons(m->requires, l);
 
-  l = cons(m->body, l);
-  l = cons(m->et_body, l);
+  for (j = 0; j < m->num_phases; j++) {
+    l = cons(m->bodies[j], l);
+  }
 
   cnt = 0;
   for (k = -3; k < (m->me->other_phases ? m->me->other_phases->size : 0); k++) {
     switch (k) {
     case -3:
+      phase = scheme_make_integer(-1);
       pt = m->me->dt;
       break;
     case -2:
+      phase = scheme_make_integer(1);
       pt = m->me->et;
       break;
     case -1:
+      phase = scheme_make_integer(0);
       pt = m->me->rt;
       break;
     default:
+      phase = m->me->other_phases->keys[k];
       pt = (Scheme_Module_Phase_Exports *)m->me->other_phases->vals[k];
     }
     
@@ -1203,76 +1208,58 @@ static Scheme_Object *write_module(Scheme_Object *obj)
       if (pt->provide_src_phases) {
         v = scheme_make_vector(count, NULL);
         for (i = 0; i < count; i++) {
-          SCHEME_VEC_ELS(v)[i] = (pt->provide_src_phases[i] ? scheme_true : scheme_false);
+          SCHEME_VEC_ELS(v)[i] = scheme_make_integer(pt->provide_src_phases[i]);
         } 
       } else
         v = scheme_false;
       l = cons(v, l);
 
+      if ((SCHEME_INT_VAL(phase) >= 0) && (SCHEME_INT_VAL(phase) < m->num_phases)) {
+        Scheme_Module_Export_Info *exp_info = m->exp_infos[SCHEME_INT_VAL(phase)];
+
+        if (exp_info) {
+          v = scheme_false;
+
+          if (exp_info->provide_protects) {
+            for (i = 0; i < count; i++) {
+              if (exp_info->provide_protects[i])
+                break;
+            }
+            if (i < count) {
+              v = scheme_make_vector(count, NULL);
+              for (i = 0; i < count; i++) {
+                SCHEME_VEC_ELS(v)[i] = (exp_info->provide_protects[i] ? scheme_true : scheme_false);
+              }
+            }
+          }
+          l = cons(v, l);
+
+          count = exp_info->num_indirect_provides;
+          l = cons(scheme_make_integer(count), l);
+          v = scheme_make_vector(count, NULL);
+          for (i = 0; i < count; i++) {
+            SCHEME_VEC_ELS(v)[i] = exp_info->indirect_provides[i];
+          }
+          l = cons(v, l);
+          
+          count = exp_info->num_indirect_syntax_provides;
+          l = cons(scheme_make_integer(count), l);
+          v = scheme_make_vector(count, NULL);
+          for (i = 0; i < count; i++) {
+            SCHEME_VEC_ELS(v)[i] = exp_info->indirect_syntax_provides[i];
+          }
+          l = cons(v, l);
+        } else
+          l = cons(scheme_void, l);
+      } else
+        l = cons(scheme_void, l);
+      
       l = cons(pt->phase_index, l);
       cnt++;
     }
   }
-
   l = cons(scheme_make_integer(cnt), l);
-
-  count = m->me->rt->num_provides;
-  if (m->provide_protects) {
-    for (i = 0; i < count; i++) {
-      if (m->provide_protects[i])
-	break;
-    }
-    if (i < count) {
-      v = scheme_make_vector(count, NULL);
-      for (i = 0; i < count; i++) {
-	SCHEME_VEC_ELS(v)[i] = (m->provide_protects[i] ? scheme_true : scheme_false);
-      }
-    } else
-      v = scheme_false;
-    l = cons(v, l);
-  } else
-    l = cons(scheme_false, l);
-  
-  count = m->me->et->num_provides;
-  if (m->et_provide_protects) {
-    for (i = 0; i < count; i++) {
-      if (m->et_provide_protects[i])
-	break;
-    }
-    if (i < count) {
-      v = scheme_make_vector(count, NULL);
-      for (i = 0; i < count; i++) {
-	SCHEME_VEC_ELS(v)[i] = (m->et_provide_protects[i] ? scheme_true : scheme_false);
-      }
-    } else
-      v = scheme_false;
-    l = cons(v, l);
-  } else
-    l = cons(scheme_false, l);
-  
-  count = m->num_indirect_provides;
-  l = cons(scheme_make_integer(count), l);
-  v = scheme_make_vector(count, NULL);
-  for (i = 0; i < count; i++) {
-    SCHEME_VEC_ELS(v)[i] = m->indirect_provides[i];
-  }
-  l = cons(v, l);
-
-  count = m->num_indirect_syntax_provides;
-  l = cons(scheme_make_integer(count), l);
-  v = scheme_make_vector(count, NULL);
-  for (i = 0; i < count; i++) {
-    SCHEME_VEC_ELS(v)[i] = m->indirect_syntax_provides[i];
-  }
-  l = cons(v, l);
-
-  count = m->num_indirect_et_provides;
-  l = cons(scheme_make_integer(count), l);
-  v = scheme_make_vector(count, NULL);
-  for (i = 0; i < count; i++) {
-    SCHEME_VEC_ELS(v)[i] = m->et_indirect_provides[i];
-  }
-  l = cons(v, l);
+  l = cons(scheme_make_integer(m->num_phases), l);
 
   l = cons((Scheme_Object *)m->prefix, l);
   l = cons(m->dummy, l);
@@ -1318,12 +1305,14 @@ static int check_requires_ok(Scheme_Object *l)
 static Scheme_Object *read_module(Scheme_Object *obj)
 {
   Scheme_Module *m;
-  Scheme_Object *ie, *nie;
-  Scheme_Object *eesp, *esp, *esn, *esph, *es, *esnom, *e, *nve, *ne, **v;
+  Scheme_Object *ie, *nie, **bodies;
+  Scheme_Object *esp, *esn, *esph, *es, *esnom, *e, *nve, *ne, **v;
   Scheme_Module_Exports *me;
   Scheme_Module_Phase_Exports *pt;
-  char *ps, *sps;
-  int i, count, cnt;
+  Scheme_Module_Export_Info **exp_infos, *exp_info;
+  char *ps;
+  int *sps;
+  int i, j, count, cnt;
 
   m = MALLOC_ONE_TAGGED(Scheme_Module);
   m->so.type = scheme_module_type;
@@ -1387,67 +1376,21 @@ static Scheme_Object *read_module(Scheme_Object *obj)
   obj = SCHEME_CDR(obj);
 
   if (!SCHEME_PAIRP(obj)) return_NULL();
-  ie = SCHEME_CAR(obj);
+  cnt = SCHEME_INT_VAL(SCHEME_CAR(obj));
   obj = SCHEME_CDR(obj);
 
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  nie = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
-  
-  count = SCHEME_INT_VAL(nie);
+  if (cnt < 1) return_NULL();
 
-  if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
-  v = MALLOC_N(Scheme_Object *, count);
-  for (i = 0; i < count; i++) {
-    v[i] = SCHEME_VEC_ELS(ie)[i];
+  m->num_phases = cnt;
+  exp_infos = MALLOC_N(Scheme_Module_Export_Info *, cnt);
+  while (cnt--) {
+    exp_info = MALLOC_ONE_RT(Scheme_Module_Export_Info);
+    SET_REQUIRED_TAG(exp_info->type = scheme_rt_export_info);
+    exp_infos[cnt] = exp_info;
   }
-  m->et_indirect_provides = v;
-  m->num_indirect_et_provides = count;
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  ie = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  nie = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
+  m->exp_infos = exp_infos;
+  cnt = m->num_phases;
   
-  count = SCHEME_INT_VAL(nie);
-
-  if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
-  v = MALLOC_N(Scheme_Object *, count);
-  for (i = 0; i < count; i++) {
-    v[i] = SCHEME_VEC_ELS(ie)[i];
-  }
-  m->indirect_syntax_provides = v;
-  m->num_indirect_syntax_provides = count;
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  ie = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  nie = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
-  
-  count = SCHEME_INT_VAL(nie);
-
-  if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
-  v = MALLOC_N(Scheme_Object *, count);
-  for (i = 0; i < count; i++) {
-    v[i] = SCHEME_VEC_ELS(ie)[i];
-  }
-  m->indirect_provides = v;
-  m->num_indirect_provides = count;
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  eesp = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  esp = SCHEME_CAR(obj);
-  obj = SCHEME_CDR(obj);
-
   if (!SCHEME_PAIRP(obj)) return_NULL();
   cnt = SCHEME_INT_VAL(SCHEME_CAR(obj));
   obj = SCHEME_CDR(obj);
@@ -1482,6 +1425,67 @@ static Scheme_Object *read_module(Scheme_Object *obj)
       scheme_hash_set(me->other_phases, phase, (Scheme_Object *)pt);      
     }
 
+    if (!SCHEME_PAIRP(obj)) return_NULL();
+    ie = SCHEME_CAR(obj);
+    obj = SCHEME_CDR(obj);
+    if (SCHEME_VOIDP(ie)) {
+      /* no exp_infos entry */
+      count = -1;
+    } else {
+      if (!SCHEME_INTP(phase) || (SCHEME_INT_VAL(phase) < 0)
+          || (SCHEME_INT_VAL(phase) >= m->num_phases))
+        return_NULL();
+      exp_info = m->exp_infos[SCHEME_INT_VAL(phase)];
+      
+      if (!SCHEME_PAIRP(obj)) return_NULL();
+      nie = SCHEME_CAR(obj);
+      obj = SCHEME_CDR(obj);
+  
+      count = SCHEME_INT_VAL(nie);
+      if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
+      v = MALLOC_N(Scheme_Object *, count);
+      for (i = 0; i < count; i++) {
+        v[i] = SCHEME_VEC_ELS(ie)[i];
+      }
+      exp_info->indirect_syntax_provides = v;
+      exp_info->num_indirect_syntax_provides = count;
+
+      if (!SCHEME_PAIRP(obj)) return_NULL();
+      ie = SCHEME_CAR(obj);
+      obj = SCHEME_CDR(obj);
+
+      if (!SCHEME_PAIRP(obj)) return_NULL();
+      nie = SCHEME_CAR(obj);
+      obj = SCHEME_CDR(obj);
+  
+      count = SCHEME_INT_VAL(nie);
+
+      if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
+      v = MALLOC_N(Scheme_Object *, count);
+      for (i = 0; i < count; i++) {
+        v[i] = SCHEME_VEC_ELS(ie)[i];
+      }
+      exp_info->indirect_provides = v;
+      exp_info->num_indirect_provides = count;
+
+      if (!SCHEME_PAIRP(obj)) return_NULL();
+      esp = SCHEME_CAR(obj);
+      obj = SCHEME_CDR(obj);
+
+      if (SCHEME_FALSEP(esp)) {
+        exp_info->provide_protects = NULL;
+        count = -1;
+      } else {
+        if (!SCHEME_VECTORP(esp)) return_NULL();
+        count = SCHEME_VEC_SIZE(esp);
+        ps = MALLOC_N_ATOMIC(char, count);
+        for (i = 0; i < count; i++) {
+          ps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(esp)[i]);
+        }
+        exp_info->provide_protects = ps;
+      }
+    }
+
     if (!SCHEME_PAIRP(obj)) return_NULL();
     esph = SCHEME_CAR(obj);
     obj = SCHEME_CDR(obj);
@@ -1510,6 +1514,8 @@ static Scheme_Object *read_module(Scheme_Object *obj)
     ne = SCHEME_CAR(obj);
     obj = SCHEME_CDR(obj);
 
+    if ((count != -1) && (SCHEME_INT_VAL(ne) != count)) return_NULL();
+    
     count = SCHEME_INT_VAL(ne);
     pt->num_provides = count;
     pt->num_var_provides = SCHEME_INT_VAL(nve);
@@ -1550,9 +1556,9 @@ static Scheme_Object *read_module(Scheme_Object *obj)
       sps = NULL;
     else {
       if (!SCHEME_VECTORP(esph) || (SCHEME_VEC_SIZE(esph) != count)) return_NULL();
-      sps = MALLOC_N_ATOMIC(char, count);
+      sps = MALLOC_N_ATOMIC(int, count);
       for (i = 0; i < count; i++) {
-        sps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(esph)[i]);
+        sps[i] = SCHEME_INT_VAL(SCHEME_VEC_ELS(esph)[i]);
       }
     }
     pt->provide_src_phases = sps;
@@ -1560,55 +1566,40 @@ static Scheme_Object *read_module(Scheme_Object *obj)
 
   count = me->rt->num_provides;
 
-  if (SCHEME_FALSEP(esp)) {
-    m->provide_protects = NULL;
-  } else {
-    if (!SCHEME_VECTORP(esp) || (SCHEME_VEC_SIZE(esp) != count)) return_NULL();
-    ps = MALLOC_N_ATOMIC(char, count);
-    for (i = 0; i < count; i++) {
-      ps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(esp)[i]);
-    }
-    m->provide_protects = ps;
-  }
-
-  if (SCHEME_FALSEP(eesp)) {
-    m->et_provide_protects = NULL;
-  } else {
-    if (!SCHEME_VECTORP(eesp) || (SCHEME_VEC_SIZE(eesp) != count)) return_NULL();
-    ps = MALLOC_N_ATOMIC(char, count);
-    for (i = 0; i < count; i++) {
-      ps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(eesp)[i]);
-    }
-    m->et_provide_protects = ps;
-  }
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  e = SCHEME_CAR(obj);
-  if (!SCHEME_VECTORP(e)) return_NULL();
-  m->et_body = e;
-  for (i = SCHEME_VEC_SIZE(e); i--; ) {
-    e = SCHEME_VEC_ELS(m->et_body)[i];
+  bodies = MALLOC_N(Scheme_Object*, m->num_phases);
+  m->bodies = bodies;
+  for (j = m->num_phases; j--; ) {
+    if (!SCHEME_PAIRP(obj)) return_NULL();
+    e = SCHEME_CAR(obj);
     if (!SCHEME_VECTORP(e)) return_NULL();
-    /* SCHEME_VEC_ELS(e)[1] should be code */
-    if (!SCHEME_INTP(SCHEME_VEC_ELS(e)[2])) return_NULL();
-    if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(e)[3]), scheme_resolve_prefix_type))
-      return_NULL();
-    e = SCHEME_VEC_ELS(e)[0];
-    if (!SCHEME_SYMBOLP(e)) {
-      while (SCHEME_PAIRP(e)) {
-        if (!SCHEME_SYMBOLP(SCHEME_CAR(e))) return_NULL();
-        e = SCHEME_CDR(e);
+    if (j) {
+      bodies[j] = e;
+      for (i = SCHEME_VEC_SIZE(e); i--; ) {
+        e = SCHEME_VEC_ELS(bodies[j])[i];
+        if (!SCHEME_VECTORP(e)) return_NULL();
+        if (SCHEME_VEC_SIZE(e) != 5) return_NULL();
+        /* SCHEME_VEC_ELS(e)[1] should be code */
+        if (!SCHEME_INTP(SCHEME_VEC_ELS(e)[2])) return_NULL();
+        if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(e)[3]), scheme_resolve_prefix_type))
+          return_NULL();
+        if (SCHEME_FALSEP(SCHEME_VEC_ELS(e)[0])) {
+          if (SCHEME_FALSEP(SCHEME_VEC_ELS(e)[4])) return_NULL();
+        } else {
+          e = SCHEME_VEC_ELS(e)[0];
+          if (!SCHEME_SYMBOLP(e)) {
+            while (SCHEME_PAIRP(e)) {
+              if (!SCHEME_SYMBOLP(SCHEME_CAR(e))) return_NULL();
+              e = SCHEME_CDR(e);
+            }
+            if (!SCHEME_NULLP(e)) return_NULL();
+          }
+        }
       }
-      if (!SCHEME_NULLP(e)) return_NULL();
+    } else {
+      bodies[j] = e;
     }
+    obj = SCHEME_CDR(obj);
   }
-  obj = SCHEME_CDR(obj);
-
-  if (!SCHEME_PAIRP(obj)) return_NULL();
-  e = SCHEME_CAR(obj);
-  if (!SCHEME_VECTORP(e)) return_NULL();
-  m->body = e;
-  obj = SCHEME_CDR(obj);
 
   if (!SCHEME_PAIRP(obj)) return_NULL();
   if (scheme_proper_list_length(SCHEME_CAR(obj)) < 0) return_NULL();
diff --git a/src/racket/src/module.c b/src/racket/src/module.c
index e1a432fc6e..a90271aab6 100644
--- a/src/racket/src/module.c
+++ b/src/racket/src/module.c
@@ -90,16 +90,51 @@ static Scheme_Object *provide_expand(Scheme_Object *form, Scheme_Comp_Env *env,
 static Scheme_Module *module_load(Scheme_Object *modname, Scheme_Env *env, const char *who);
 
 static void run_module(Scheme_Env *menv, int set_ns);
-static void run_module_exptime(Scheme_Env *menv, int set_ns);
+static void run_module_exptime(Scheme_Env *menv, int phase);
 
 static void eval_exptime(Scheme_Object *names, int count,
                          Scheme_Object *expr, 
                          Scheme_Env *genv, Scheme_Comp_Env *env,
                          Resolve_Prefix *rp, int let_depth, int shift,
-                         Scheme_Bucket_Table *syntax, int for_stx,
+                         Scheme_Bucket_Table *syntax, int at_phase,
                          Scheme_Object *free_id_rename_rn,
                          Scheme_Object *insp);
 
+typedef struct Module_Begin_Expand_State {
+  /* All pointers, because it's allocated with scheme_malloc(): */
+  Scheme_Object *post_ex_rn_set;
+  Scheme_Hash_Table *tables; /* phase -> (vector toplevels requires syntaxes) */
+  Scheme_Hash_Table *all_provided; /* phase -> table like `provided' */
+  Scheme_Hash_Table *all_reprovided; /* phase -> list of (list modidx syntax except-name ...) */
+  Scheme_Hash_Tree *all_defs; /* phase -> list of sxtid */
+  Scheme_Hash_Table *all_defs_out; /* phase -> list of (cons protected? (stx-list except-name ...)) */
+  int *all_simple_renames;
+  int *_num_phases;
+  Scheme_Object *saved_provides; /* list of (cons form phase) */
+  Scheme_Hash_Table *modidx_cache;
+  Scheme_Object *redef_modname;
+} Module_Begin_Expand_State;
+
+static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_Env *env, 
+                                               Scheme_Compile_Expand_Info *rec, int drec,
+                                               Scheme_Compile_Expand_Info *erec, int derec,
+                                               int phase, Scheme_Object *body_lists,
+                                               Module_Begin_Expand_State *bxs);
+
+static Scheme_Object *expand_all_provides(Scheme_Object *form,
+                                          Scheme_Comp_Env *cenv, 
+                                          Scheme_Compile_Expand_Info *rec, int drec,
+                                          Scheme_Object *self_modidx,
+                                          Module_Begin_Expand_State *bxs,
+                                          int keep_expanded);
+
+static Scheme_Object *fixup_expanded_provides(Scheme_Object *expanded_l,
+                                              Scheme_Object *expanded_provides,
+                                              int phase);
+
+static void check_formerly_unbound(Scheme_Object *unbounds, Scheme_Comp_Env *env);
+static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv);
+
 static Scheme_Object *scheme_sys_wraps_phase_worker(intptr_t p);
 
 #define cons scheme_make_pair
@@ -153,7 +188,7 @@ READ_ONLY Scheme_Object *scheme_begin_stx;
 READ_ONLY Scheme_Object *scheme_define_values_stx;
 READ_ONLY Scheme_Object *scheme_define_syntaxes_stx;
 READ_ONLY Scheme_Object *scheme_top_stx;
-READ_ONLY Scheme_Object *scheme_define_for_syntaxes_stx;
+READ_ONLY Scheme_Object *scheme_begin_for_syntax_stx;
 READ_ONLY static Scheme_Object *modbeg_syntax;
 READ_ONLY static Scheme_Object *require_stx;
 READ_ONLY static Scheme_Object *provide_stx;
@@ -209,7 +244,7 @@ typedef void (*Check_Func)(Scheme_Object *prnt_name, Scheme_Object *name,
                            Scheme_Object *err_src, Scheme_Object *mark_src,
                            Scheme_Object *to_phase, Scheme_Object *src_phase_index,
                            Scheme_Object *nominal_export_phase);
-static void parse_requires(Scheme_Object *form,
+static void parse_requires(Scheme_Object *form, int at_phase,
                            Scheme_Object *base_modidx,
                            Scheme_Env *env,
                            Scheme_Module *for_m,
@@ -221,35 +256,37 @@ static void parse_requires(Scheme_Object *form,
                            int *all_simple,
                            Scheme_Hash_Table *modix_cache);
 static void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
+                           int at_phase,
                            Scheme_Hash_Table *all_provided,
                            Scheme_Hash_Table *all_reprovided,
                            Scheme_Object *self_modidx,
-                           Scheme_Object **_all_defs_out, 
-                           Scheme_Object **_et_all_defs_out, 
+                           Scheme_Hash_Table *all_defs_out, 
                            Scheme_Hash_Table *tables,
-                           Scheme_Object *all_defs, Scheme_Object *all_et_defs,
+                           Scheme_Hash_Tree *all_defs,
                            Scheme_Comp_Env *cenv, Scheme_Compile_Info *rec, int drec,
-                           Scheme_Object **_expanded);
+                           Scheme_Object **_expanded,
+                           Scheme_Object *begin_stx);
 static int compute_reprovides(Scheme_Hash_Table *all_provided,
                               Scheme_Hash_Table *all_reprovided, 
                               Scheme_Module *mod_for_requires,
                               Scheme_Hash_Table *tables,
                               Scheme_Env *genv, 
-                              Scheme_Object *all_rt_defs, Scheme_Object *all_rt_defs_out, 
-                              Scheme_Object *all_et_defs, Scheme_Object *all_et_defs_out, 
+                              int num_phases,
+                              Scheme_Hash_Tree *all_defs, Scheme_Hash_Table *all_defs_out,
                               const char *matching_form,
                               Scheme_Object *all_mods, Scheme_Object *all_phases);
-static char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *tables,
-                                    Scheme_Module_Exports *me,
-                                    Scheme_Env *genv,
-                                    Scheme_Object *form,
-                                    char **_phase1_protects);
+static void compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *tables,
+                                   Scheme_Module_Exports *me,
+                                   Scheme_Env *genv,
+                                   Scheme_Object *form,
+                                   int num_phases, Scheme_Module_Export_Info **exp_infos);
 static Scheme_Object **compute_indirects(Scheme_Env *genv, 
                                          Scheme_Module_Phase_Exports *pt,
                                          int *_count,
                                          int vars);
 static void start_module(Scheme_Module *m, Scheme_Env *env, int restart, Scheme_Object *syntax_idx, 
-                         int eval_exp, int eval_run, intptr_t base_phase, Scheme_Object *cycle_list);
+                         int eval_exp, int eval_run, intptr_t base_phase, Scheme_Object *cycle_list,
+                         int not_new);
 static void eval_module_body(Scheme_Env *menv, Scheme_Env *env);
 
 static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Object *argv[], 
@@ -257,7 +294,7 @@ static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Obj
 
 static Scheme_Object *default_module_resolver(int argc, Scheme_Object **argv);
 
-static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Object **exss, char *exps, char *exets,
+static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Object **exss, char *exps, int *exets,
                            Scheme_Object **exsnoms,
 			   int start, int count, int do_uninterned);
 
@@ -396,12 +433,25 @@ void scheme_init_module_resolver(void)
   scheme_set_param(config, MZCONFIG_CURRENT_MODULE_NAME, scheme_false);
 }
 
+static void add_exp_infos(Scheme_Module *m)
+{
+  Scheme_Module_Export_Info **exp_infos, *exp_info;
+  
+  exp_infos = MALLOC_N(Scheme_Module_Export_Info *, 1);
+  exp_info = MALLOC_ONE_RT(Scheme_Module_Export_Info);
+  SET_REQUIRED_TAG(exp_info->type = scheme_rt_export_info);
+  exp_infos[0] = exp_info;
+  m->exp_infos = exp_infos;
+  m->num_phases = 1;
+}
+
 void scheme_finish_kernel(Scheme_Env *env)
 {
   /* When this function is called, the initial namespace has all the
      primitive bindings for syntax and procedures. This function fills
      in the module wrapper for #%kernel. */
   Scheme_Object *w;
+  char *running;
 
   REGISTER_SO(kernel);
 
@@ -424,7 +474,7 @@ void scheme_finish_kernel(Scheme_Env *env)
   kernel->tt_requires = scheme_null;
   kernel->dt_requires = scheme_null;
   kernel->other_requires = NULL;
-
+  add_exp_infos(kernel);
   
   {
     Scheme_Bucket_Table *ht;
@@ -482,8 +532,10 @@ void scheme_finish_kernel(Scheme_Env *env)
     kernel->me->rt->num_var_provides = syntax_start;
     scheme_populate_pt_ht(kernel->me->rt);
 
-    env->running = 1;
-    env->et_running = 1;
+    running = (char *)scheme_malloc_atomic(2);
+    running[0] = 1;
+    running[1] = 1;
+    env->running = running;
     env->attached = 1;
 
     /* Since this is the first module rename, it's registered as
@@ -509,7 +561,7 @@ void scheme_finish_kernel(Scheme_Env *env)
   REGISTER_SO(scheme_begin_stx);
   REGISTER_SO(scheme_define_values_stx);
   REGISTER_SO(scheme_define_syntaxes_stx);
-  REGISTER_SO(scheme_define_for_syntaxes_stx);
+  REGISTER_SO(scheme_begin_for_syntax_stx);
   REGISTER_SO(require_stx);
   REGISTER_SO(provide_stx);
   REGISTER_SO(set_stx);
@@ -533,7 +585,7 @@ void scheme_finish_kernel(Scheme_Env *env)
   scheme_begin_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin"), scheme_false, w, 0, 0);
   scheme_define_values_stx = scheme_datum_to_syntax(scheme_intern_symbol("define-values"), scheme_false, w, 0, 0);
   scheme_define_syntaxes_stx = scheme_datum_to_syntax(scheme_intern_symbol("define-syntaxes"), scheme_false, w, 0, 0);
-  scheme_define_for_syntaxes_stx = scheme_datum_to_syntax(scheme_intern_symbol("define-values-for-syntax"), scheme_false, w, 0, 0);
+  scheme_begin_for_syntax_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin-for-syntax"), scheme_false, w, 0, 0);
   require_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%require"), scheme_false, w, 0, 0);
   provide_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%provide"), scheme_false, w, 0, 0);
   set_stx = scheme_datum_to_syntax(scheme_intern_symbol("set!"), scheme_false, w, 0, 0);
@@ -545,7 +597,6 @@ void scheme_finish_kernel(Scheme_Env *env)
   letrec_values_stx = scheme_datum_to_syntax(scheme_intern_symbol("letrec-values"), scheme_false, w, 0, 0);
   if_stx = scheme_datum_to_syntax(scheme_intern_symbol("if"), scheme_false, w, 0, 0);
   begin0_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin0"), scheme_false, w, 0, 0);
-  set_stx = scheme_datum_to_syntax(scheme_intern_symbol("set!"), scheme_false, w, 0, 0);
   with_continuation_mark_stx = scheme_datum_to_syntax(scheme_intern_symbol("with-continuation-mark"), scheme_false, w, 0, 0);
   letrec_syntaxes_stx = scheme_datum_to_syntax(scheme_intern_symbol("letrec-syntaxes+values"), scheme_false, w, 0, 0);
   var_ref_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%variable-reference"), scheme_false, w, 0, 0);
@@ -774,7 +825,7 @@ void scheme_install_initial_module_set(Scheme_Env *env)
 
     /* Make sure module is running: */
     m = (Scheme_Module *)scheme_hash_get(initial_modules_env->module_registry->loaded, a[1]);
-    start_module(m, initial_modules_env, 0, a[1], 0, 1, 0, scheme_null);
+    start_module(m, initial_modules_env, 0, a[1], 0, 1, 0, scheme_null, 0);
 
     namespace_attach_module(3, a);
   }
@@ -994,7 +1045,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
                   Scheme_Config *config;
                   Scheme_Cont_Frame_Data cframe;
 
-                  start_module(m, env, 0, modidx, 0, 1, base_phase, scheme_null);
+                  start_module(m, env, 0, modidx, 0, 1, base_phase, scheme_null, 0);
                   ns = scheme_make_namespace(0, NULL);
                   a[0] = (Scheme_Object *)env;
                   a[1] = srcm->modname;
@@ -1032,8 +1083,8 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
       }
 
       if (i < count) {
-	if (srcm->provide_protects)
-	  protected = srcm->provide_protects[i];
+	if (srcm->exp_infos[0]->provide_protects)
+	  protected = srcm->exp_infos[0]->provide_protects[i];
 	srcmname = (srcm->me->rt->provide_srcs ? srcm->me->rt->provide_srcs[i] : scheme_false);
 	if (SCHEME_FALSEP(srcmname))
 	  srcmname = srcm->modname;
@@ -1047,27 +1098,28 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
       if (i == count) {
 	if (indirect_ok) {
 	  /* Try indirect provides: */
+          Scheme_Module_Export_Info *exp_info = m->exp_infos[0];
 	  srcm = m;
-	  count = srcm->num_indirect_provides;
+	  count = exp_info->num_indirect_provides;
 	  if (position >= 0) {
 	    i = position;
-	    if ((i < srcm->num_indirect_provides)
-		&& (SCHEME_SYM_LEN(name) == SCHEME_SYM_LEN(srcm->indirect_provides[i]))
-		&& !memcmp(SCHEME_SYM_VAL(name), SCHEME_SYM_VAL(srcm->indirect_provides[i]), SCHEME_SYM_LEN(name))) {
-	      name = srcm->indirect_provides[i];
+	    if ((i < exp_info->num_indirect_provides)
+		&& (SCHEME_SYM_LEN(name) == SCHEME_SYM_LEN(exp_info->indirect_provides[i]))
+		&& !memcmp(SCHEME_SYM_VAL(name), SCHEME_SYM_VAL(exp_info->indirect_provides[i]), SCHEME_SYM_LEN(name))) {
+	      name = exp_info->indirect_provides[i];
 	      srcname = name;
 	      srcmname = srcm->modname;
-	      if (srcm->provide_protects)
-		protected = srcm->provide_protects[i];
+	      if (exp_info->provide_protects)
+		protected = exp_info->provide_protects[i];
 	    } else
 	      i = count; /* not found */
 	  } else {
 	    for (i = 0; i < count; i++) {
-	      if (SAME_OBJ(name, srcm->indirect_provides[i])) {
+	      if (SAME_OBJ(name, exp_info->indirect_provides[i])) {
 		srcname = name;
 		srcmname = srcm->modname;
-		if (srcm->provide_protects)
-		  protected = srcm->provide_protects[i];
+		if (exp_info->provide_protects)
+		  protected = exp_info->provide_protects[i];
 		break;
 	      }
 	    }
@@ -1099,7 +1151,8 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
                 ? 0
                 : 1),
                base_phase, 
-               scheme_null);
+               scheme_null,
+               0);
 
   if (SCHEME_SYMBOLP(name)) {
     Scheme_Bucket *b;
@@ -1177,7 +1230,7 @@ static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Obj
 
   rns = scheme_make_module_rename_set(mzMOD_RENAME_TOPLEVEL, NULL, insp);
 
-  parse_requires(form, scheme_false, env, NULL,
+  parse_requires(form, env->phase, scheme_false, env, NULL,
                  rns, NULL,
                  NULL /* ck */, NULL /* data */,
                  NULL, 
@@ -1692,8 +1745,9 @@ static Scheme_Object *do_namespace_attach_module(const char *who, int argc, Sche
             start_module(m2, 
                          from_env->label_env, 0, 
                          main_modidx, 
-                         0, 0, from_env->phase,
-                         scheme_null);
+                         0, 0, -1,
+                         scheme_null,
+                         0);
 
             scheme_pop_continuation_frame(&cframe);
             
@@ -2373,7 +2427,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn,
 {
   int i, saw_mb, numvals;
   Scheme_Object **exs, **exss, **exsns, *midx, *info, *vec, *nml, *mark_src;
-  char *exets;
+  int *exets;
   int with_shared = 1;
 
   saw_mb = 0;
@@ -2422,7 +2476,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn,
       SCHEME_VEC_ELS(vec)[5] = orig_src;
       SCHEME_VEC_ELS(vec)[6] = mark_src;
       SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false);
-      SCHEME_VEC_ELS(vec)[8] = exets ? scheme_make_integer(exets[i]) : scheme_false;
+      SCHEME_VEC_ELS(vec)[8] = exets ? scheme_make_integer(exets[i]) : scheme_make_integer(0);
       scheme_hash_set(required, exs[i], vec);
     }
   }
@@ -2531,7 +2585,7 @@ static int add_simple_require_renames(Scheme_Object *orig_src,
 void scheme_prep_namespace_rename(Scheme_Env *menv)
 {
   scheme_prepare_exp_env(menv);
-  start_module(menv->module, menv, 0, NULL, -1, 1, menv->phase, scheme_null);
+  start_module(menv->module, menv, 0, NULL, -1, 1, menv->phase, scheme_null, 1);
 
   if (!menv->rename_set_ready) {
     if (menv->module->rn_stx) {
@@ -2544,7 +2598,7 @@ void scheme_prep_namespace_rename(Scheme_Env *menv)
 	/* Reconstruct renames based on defns and requires. This case is
            used only when it's easy to reconstruct: no renames, no for-syntax
            definitions, etc. */
-	int i;
+	int i, j;
 	Scheme_Module *im;
 	Scheme_Object *l, *idx, *one_rn, *shift, *name;
 
@@ -2559,19 +2613,20 @@ void scheme_prep_namespace_rename(Scheme_Env *menv)
                                         scheme_make_integer(0), NULL, 0);
 	  }
 	}
-	/* Local, not provided: */
-	for (i = 0; i < m->num_indirect_provides; i++) {
-	  name = m->indirect_provides[i];
-	  scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, 0, 
-                                      scheme_make_integer(0), NULL, 0);
-	}
-        for (i = 0; i < m->num_indirect_syntax_provides; i++) {
-	  name = m->indirect_syntax_provides[i];
-	  scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, 0, 
-                                      scheme_make_integer(0), NULL, 0);
-	}
-
-        one_rn = scheme_get_module_rename_from_set(rns, scheme_make_integer(1), 1);
+        for (j = 0; j < m->num_phases; j++) {
+          Scheme_Module_Export_Info *exp_info = m->exp_infos[j];
+          one_rn = scheme_get_module_rename_from_set(rns, scheme_make_integer(j), 1);
+          for (i = 0; i < exp_info->num_indirect_provides; i++) {
+            name = exp_info->indirect_provides[i];
+            scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, j, 
+                                        scheme_make_integer(j), NULL, 0);
+          }
+          for (i = 0; i < exp_info->num_indirect_syntax_provides; i++) {
+            name = exp_info->indirect_syntax_provides[i];
+            scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, j, 
+                                        scheme_make_integer(j), NULL, 0);
+          }
+        }
 
 	/* Required: */
         for (i = -4; i < (menv->other_require_names ? menv->other_require_names->size : 0); i++) {
@@ -3108,7 +3163,7 @@ static Scheme_Object *module_export_protected_p(int argc, Scheme_Object **argv)
   count = m->me->rt->num_provides;
   for (i = 0; i < count; i++) {
     if (SAME_OBJ(name, m->me->rt->provides[i])) {
-      if (m->provide_protects && m->provide_protects[i])
+      if (m->exp_infos[0]->provide_protects && m->exp_infos[0]->provide_protects[i])
 	return scheme_true;
       else
 	return scheme_false;
@@ -3445,15 +3500,22 @@ static int is_procedure_expression(Scheme_Object *e)
 
 static void setup_accessible_table(Scheme_Module *m)
 {
-  if (!m->accessible) {
+  if (!m->exp_infos[0]->accessible) {
     Scheme_Module_Phase_Exports *pt;
     int j;
 
-    for (j = 0; j < 2; j++) {
+    for (j = 0; j < m->num_phases; j++) {
       if (!j)
         pt = m->me->rt;
-      else
+      else if (j == 1)
         pt = m->me->et;
+      else {
+        if (m->me->other_phases)
+          pt = (Scheme_Module_Phase_Exports *)scheme_hash_get(m->me->other_phases,
+                                                              scheme_make_integer(j));
+        else
+          pt = NULL;
+      }
       
       if (pt) {
         Scheme_Hash_Table *ht;
@@ -3467,16 +3529,9 @@ static void setup_accessible_table(Scheme_Module *m)
           }
         }
         
-        if (j == 0) {
-          count = m->num_indirect_provides;
-          for (i = 0; i < count; i++) {
-            scheme_hash_set(ht, m->indirect_provides[i], scheme_make_integer(i + nvp));
-          }
-        } else {
-          count = m->num_indirect_et_provides;
-          for (i = 0; i < count; i++) {
-            scheme_hash_set(ht, m->et_indirect_provides[i], scheme_make_integer(i + nvp));
-          }
+        count = m->exp_infos[j]->num_indirect_provides;
+        for (i = 0; i < count; i++) {
+          scheme_hash_set(ht, m->exp_infos[j]->indirect_provides[i], scheme_make_integer(i + nvp));
         }
         
         /* Add syntax as negative ids: */
@@ -3489,11 +3544,11 @@ static void setup_accessible_table(Scheme_Module *m)
 
         if (!j) {
           /* find constants: */
-          int i, cnt = SCHEME_VEC_SIZE(m->body), k;
+          int i, cnt = SCHEME_VEC_SIZE(m->bodies[0]), k;
           Scheme_Object *form, *tl;
 
           for (i = 0; i < cnt; i++) {
-            form = SCHEME_VEC_ELS(m->body)[i];
+            form = SCHEME_VEC_ELS(m->bodies[0])[i];
             if (SAME_TYPE(SCHEME_TYPE(form), scheme_define_values_type)) {
               for (k = SCHEME_VEC_SIZE(form); k-- > 1; ) {
                 tl = SCHEME_VEC_ELS(form)[k];
@@ -3529,10 +3584,9 @@ static void setup_accessible_table(Scheme_Module *m)
               }
             }
           }
+        }
 
-          m->accessible = ht;
-        } else
-          m->et_accessible = ht;
+        m->exp_infos[j]->accessible = ht;
       }
     }
   }
@@ -3542,10 +3596,7 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, intptr_t
 {
   Scheme_Env *menv;
 
-  if (!rev_mod_phase)
-    menv = get_special_modenv(name);
-  else
-    menv = NULL;
+  menv = get_special_modenv(name);
 
   if (!menv) {
     Scheme_Object *chain;
@@ -3633,7 +3684,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
     symbol = scheme_tl_id_sym(env, symbol, NULL, 0, NULL, NULL);
 
   if (scheme_is_kernel_env(env)
-      || ((env->module->primitive && !env->module->provide_protects))) {
+      || ((env->module->primitive && !env->module->exp_infos[0]->provide_protects))) {
     if (want_pos)
       return scheme_make_integer(-1);
     else
@@ -3671,12 +3722,9 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
         int num_indirect_provides;
         Scheme_Object **indirect_provides;
 
-        if (env->mod_phase == 0) {
-          num_indirect_provides = env->module->num_indirect_provides;
-          indirect_provides = env->module->indirect_provides;
-        } else if (env->mod_phase == 1) {
-          num_indirect_provides = env->module->num_indirect_et_provides;
-          indirect_provides = env->module->et_indirect_provides;
+        if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases)) {
+          num_indirect_provides = env->module->exp_infos[env->mod_phase]->num_indirect_provides;
+          indirect_provides = env->module->exp_infos[env->mod_phase]->indirect_provides;
         } else {
           num_indirect_provides = 0;
           indirect_provides = NULL;
@@ -3699,11 +3747,9 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
           if ((position < pt->num_var_provides)
               && scheme_module_protected_wrt(env->insp, prot_insp)) {
             char *provide_protects;
-            
-            if (env->mod_phase == 0)
-              provide_protects = env->module->provide_protects;
-            else if (env->mod_phase == 0)
-              provide_protects = env->module->et_provide_protects;
+
+            if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases))
+              provide_protects = env->module->exp_infos[env->mod_phase]->provide_protects;
             else
               provide_protects = NULL;
             
@@ -3728,10 +3774,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
     } else {
       Scheme_Object *pos;
 
-      if (!env->mod_phase)
-        pos = scheme_hash_get(env->module->accessible, symbol);
-      else if (env->mod_phase == 1)
-        pos = scheme_hash_get(env->module->et_accessible, symbol);
+      if (env->mod_phase < env->module->num_phases)
+        pos = scheme_hash_get(env->module->exp_infos[env->mod_phase]->accessible, symbol);
       else
         pos = NULL;
 
@@ -3757,10 +3801,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
       if (pos) {
         char *provide_protects;
 
-        if (env->mod_phase == 0)
-          provide_protects = env->module->provide_protects;
-        else if (env->mod_phase == 1)
-          provide_protects = env->module->et_provide_protects;
+        if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases))
+          provide_protects = env->module->exp_infos[env->mod_phase]->provide_protects;
         else
           provide_protects = NULL;
 
@@ -3880,7 +3922,7 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem
 
   setup_accessible_table(m);
 
-  pos = scheme_hash_get(m->accessible, varname);
+  pos = scheme_hash_get(m->exp_infos[0]->accessible, varname);
   
   if (pos && (SCHEME_INT_VAL(pos) >= 0))
     return SCHEME_INT_VAL(pos);
@@ -3888,7 +3930,8 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem
     return -1;
 }
 
-Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name)
+Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, 
+                                    Scheme_Object *name, int mod_phase)
 {
   if (SAME_OBJ(modname, kernel_modname)) {
     Scheme_Env *kenv;
@@ -3904,12 +3947,23 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Sch
   } else {
     Scheme_Env *menv;
     Scheme_Object *val;
+    int i;
+
+    for (i = 0; i < mod_phase; i++) {
+      env = env->template_env;
+      if (!env) return NULL;
+    }
 
     menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(env->modchain), modname);
-    
+
     if (!menv)
       return NULL;
 
+    for (i = 0; i < mod_phase; i++) {
+      menv = menv->exp_env;
+      if (!menv) return NULL;
+    }
+    
     if (SCHEME_STXP(name))
       name = scheme_tl_id_sym(menv, name, NULL, 0, NULL, NULL);
 
@@ -4002,27 +4056,27 @@ static Scheme_Object *add_start(Scheme_Object *v, int base_phase, int eval_exp,
 #if 0
 static int indent = 0;
 # define show_indent(d) (indent += d)
-static void show(const char *what, Scheme_Env *menv, int v1, int v2, int base_phase)
+static void show(const char *what, Scheme_Env *menv, int v1, int v2, int ph, int base_phase)
 {
   if (menv->phase > 3) return;
-  if (1 || SCHEME_SYMBOLP(SCHEME_PTR_VAL(menv->module->modname)))
-    if (1 || SCHEME_SYM_VAL(SCHEME_PTR_VAL(menv->module->modname))[0] != '#') {
+  if (0 || SCHEME_SYMBOLP(SCHEME_PTR_VAL(menv->module->modname)))
+    if (0 || SCHEME_SYM_VAL(SCHEME_PTR_VAL(menv->module->modname))[0] != '#') {
       int i;
       for (i = 0; i < indent; i++) {
         fprintf(stderr, " ");
       }
-      fprintf(stderr, "%s \t%s @%ld/%d [%d/%d] %p\n", 
+      fprintf(stderr, "%s \t%s @%ld+%d/%d [%d/%d] %p\n", 
               what, scheme_write_to_string(menv->module->modname, NULL), 
-              menv->phase, base_phase, v1, v2, menv->modchain);
+              menv->phase, ph, base_phase, v1, v2, menv->modchain);
     }
 }
-static void show_done(const char *what, Scheme_Env *menv, int v1, int v2, int base_phase){
-  show(what, menv, v1, v2, base_phase);
+static void show_done(const char *what, Scheme_Env *menv, int v1, int v2, int i, int base_phase){
+  show(what, menv, v1, v2, i, base_phase);
 }
 #else
 # define show_indent(d) /* nothing */
-# define show(w, m, v1, v2, bp) /* nothing */
-# define show_done(w, m, v1, v2, bp) /* nothing */
+# define show(w, m, v1, v2, i, bp) /* nothing */
+# define show_done(w, m, v1, v2, i, bp) /* nothing */
 #endif
 
 static void compute_require_names(Scheme_Env *menv, Scheme_Object *phase, 
@@ -4115,7 +4169,8 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
                    menv->label_env, 0, 
                    midx,
                    0, 0, base_phase,
-                   new_cycle_list);
+                   new_cycle_list,
+                   0);
     }
   }
   
@@ -4134,7 +4189,8 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
                    menv->template_env, 0, 
                    midx,
                    eval_exp, eval_run, base_phase,
-                   new_cycle_list);
+                   new_cycle_list,
+                   0);
     }
   }
 
@@ -4145,7 +4201,8 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
 
     im = module_load(scheme_module_resolve(midx, 1), env, NULL);
 
-    start_module(im, env, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
+    start_module(im, env, 0, midx, eval_exp, eval_run, base_phase, 
+                 new_cycle_list, 0);
   }
 
   scheme_prepare_exp_env(menv);
@@ -4159,7 +4216,8 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
       
       im = module_load(scheme_module_resolve(midx, 1), env, NULL);
       
-      start_module(im, menv->exp_env, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
+      start_module(im, menv->exp_env, 0, midx, eval_exp, eval_run, base_phase, 
+                   new_cycle_list, 0);
     }
   }
 
@@ -4193,7 +4251,8 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
                          menv2, 0, 
                          midx,
                          eval_exp, eval_run, base_phase,
-                         new_cycle_list);
+                         new_cycle_list,
+                         0);
           }
         } else {
           compute_require_names(menv, phase, env, syntax_idx);
@@ -4214,7 +4273,8 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
             
             im = module_load(scheme_module_resolve(midx, 1), env, NULL);
             
-            start_module(im, menv2, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
+            start_module(im, menv2, 0, midx, eval_exp, eval_run, base_phase, 
+                         new_cycle_list, 0);
           }
         }
       }
@@ -4260,7 +4320,8 @@ void *scheme_module_start_finish(struct Start_Module_Args *a)
   return NULL;
 }
 
-static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int restart, Scheme_Object *syntax_idx)
+static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int restart, 
+                                      Scheme_Object *syntax_idx, int not_new)
 {
   Scheme_Env *menv;
 
@@ -4290,18 +4351,27 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
     Scheme_Object *insp;
 
     if (!menv) {
+      char *running;
+
+      if (not_new)
+        scheme_signal_error("internal error: shouldn't instantiate module %s now",
+                            scheme_write_to_string(m->modname, NULL));
+
       /* printf("new %ld %s\n", env->phase, SCHEME_SYM_VAL(m->modname)); */
       menv = scheme_new_module_env(env, m, 0);
       scheme_hash_set(MODCHAIN_TABLE(env->modchain), m->modname, (Scheme_Object *)menv);
-      
+
+      running = (char *)scheme_malloc_atomic(menv->module->num_phases);
+      menv->running = running;
+      memset(menv->running, 0, menv->module->num_phases);
+
       menv->phase = env->phase;
       menv->link_midx = syntax_idx;
     } else {
       Scheme_Env *env2;
 
       menv->module = m;
-      menv->running = 0;
-      menv->et_running = 0;
+      memset(menv->running, 0, menv->module->num_phases);
       menv->ran = 0;
       menv->did_starts = NULL;
 
@@ -4343,8 +4413,8 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
             scheme_add_to_table(menv->toplevel, (const char *)exsns[i], NULL, 0);
         }
 
-        count = m->num_indirect_provides;
-        exsns = m->indirect_provides;
+        count = m->exp_infos[0]->num_indirect_provides;
+        exsns = m->exp_infos[0]->indirect_provides;
         for (i = 0; i < count; i++) {
           scheme_add_to_table(menv->toplevel, (const char *)exsns[i], NULL, 0);
         }
@@ -4355,122 +4425,128 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
   return menv;
 }
 
-static void expstart_module(Scheme_Env *menv, Scheme_Env *env, int restart)
+static void expstart_module(Scheme_Env *menv, Scheme_Env *env, int phase, int restart)
 {
   if (!restart) {
-    if (menv && menv->et_running)
+    if (menv && menv->running[phase])
       return;
   }
 
   if (menv->module->primitive)
     return;
 
-  menv->et_running = 1;
+  menv->running[phase] = 1;
   if (scheme_starting_up)
     menv->attached = 1; /* protect initial modules from redefinition, etc. */
 
-  run_module_exptime(menv, 0);
+  run_module_exptime(menv, phase);
 
   return;
 }
 
-static void run_module_exptime(Scheme_Env *menv, int set_ns)
+static void run_module_exptime(Scheme_Env *menv, int phase)
 {
 #ifdef MZ_USE_JIT
-  (void)scheme_module_exprun_start(menv, set_ns, scheme_make_pair(menv->module->modname, scheme_void));
+  (void)scheme_module_exprun_start(menv, phase, scheme_make_pair(menv->module->modname, scheme_void));
 #else
-  (void)scheme_module_exprun_finish(menv, set_ns);
+  (void)scheme_module_exprun_finish(menv, phase);
 #endif
 }
 
-void *scheme_module_exprun_finish(Scheme_Env *menv, int set_ns)
+void *scheme_module_exprun_finish(Scheme_Env *menv, int at_phase)
 {
   int let_depth, for_stx;
   Scheme_Object *names, *e;
   Resolve_Prefix *rp;
   Scheme_Comp_Env *rhs_env;
-  int i, cnt;
+  int i, cnt, len;
   Scheme_Env *exp_env;
-  Scheme_Bucket_Table *syntax, *for_stx_globals;
-  Scheme_Cont_Frame_Data cframe;
-  Scheme_Config *config;
-  
+  Scheme_Bucket_Table *syntax;
+
   if (menv->module->primitive)
     return NULL;
 
-  if (!SCHEME_VEC_SIZE(menv->module->et_body))
+  if ((menv->module->num_phases <= at_phase) || (!SCHEME_VEC_SIZE(menv->module->bodies[at_phase])))
     return NULL;
 
-  syntax = menv->syntax;
-
+  for (i = 1; i < at_phase; i++) {
+    menv = menv->exp_env;
+  }
   exp_env = menv->exp_env;
 
   if (!exp_env)
     return NULL;
 
-  for_stx_globals = exp_env->toplevel;
-
-  if (set_ns) {
-    config = scheme_extend_config(scheme_current_config(),
-                                  MZCONFIG_ENV,
-                                  (Scheme_Object *)menv);
-    
-    scheme_push_continuation_frame(&cframe);
-    scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
-  }
+  syntax = menv->syntax;
 
   rhs_env = scheme_new_comp_env(menv, menv->module->insp, SCHEME_TOPLEVEL_FRAME);
 
-  cnt = SCHEME_VEC_SIZE(menv->module->et_body);
+  cnt = SCHEME_VEC_SIZE(menv->module->bodies[at_phase]);
   for (i = 0; i < cnt; i++) {
-    e = SCHEME_VEC_ELS(menv->module->et_body)[i];
+    e = SCHEME_VEC_ELS(menv->module->bodies[at_phase])[i];
       
     names = SCHEME_VEC_ELS(e)[0];
     let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
     rp = (Resolve_Prefix *)SCHEME_VEC_ELS(e)[3];
     for_stx = SCHEME_TRUEP(SCHEME_VEC_ELS(e)[4]);
     e = SCHEME_VEC_ELS(e)[1];
-      
-    if (SCHEME_SYMBOLP(names))
-      names = scheme_make_pair(names, scheme_null);
+    
+    if (for_stx) {
+      names = NULL;
+      len = 0;
+    } else {
+      if (SCHEME_SYMBOLP(names))
+        names = scheme_make_pair(names, scheme_null);
+      len = scheme_list_length(names);
+    }
 
-    eval_exptime(names, scheme_list_length(names), e, exp_env, rhs_env,
-                 rp, let_depth, 1, (for_stx ? for_stx_globals : syntax), for_stx,
+    eval_exptime(names, len, e, exp_env, rhs_env,
+                 rp, let_depth, 1, (for_stx ? NULL : syntax), at_phase,
                  scheme_false, menv->module->insp);
   }
 
-  if (set_ns) {
-    scheme_pop_continuation_frame(&cframe);
-  }
-
   return NULL;
 }
 
 static void do_start_module(Scheme_Module *m, Scheme_Env *menv, Scheme_Env *env, int restart)
 {
   if (m->primitive) {
-    menv->running = 1;
+    menv->running[0] = 1;
     menv->ran = 1;
     return;
   }
 
-  if (menv->running > 0) {
+  if (menv->running[0] > 0) {
     return;
   }
   
-  menv->running = 1;
+  menv->running[0] = 1;
 
   if (menv->module->prim_body) {
     Scheme_Invoke_Proc ivk = menv->module->prim_body;
     menv->ran = 1;
-    ivk(menv, menv->phase, menv->link_midx, m->body);
+    ivk(menv, menv->phase, menv->link_midx, m->bodies[0]);
   } else {
     eval_module_body(menv, env);
   }
 }
 
-static void should_run_for_compile(Scheme_Env *menv)
+static void should_run_for_compile(Scheme_Env *menv, int phase)
 {
+  if (menv->running[phase]) return;
+
+  while (phase > 1) {
+    scheme_prepare_exp_env(menv);
+    menv = menv->exp_env;
+    phase--;
+  }
+
+#if 0
+  if (!scheme_hash_get(MODCHAIN_TABLE(menv->instance_env->modchain), menv->module->modname))
+    scheme_signal_error("internal error: inconsistent instance_env");
+#endif
+
+
   if (!menv->available_next[0]) {
     menv->available_next[0] = MODCHAIN_AVAIL(menv->modchain, 0);
     MODCHAIN_AVAIL(menv->modchain, 0) = (Scheme_Object *)menv;
@@ -4483,12 +4559,17 @@ static void should_run_for_compile(Scheme_Env *menv)
 
 static void start_module(Scheme_Module *m, Scheme_Env *env, int restart, 
                          Scheme_Object *syntax_idx, int eval_exp, int eval_run, intptr_t base_phase,
-                         Scheme_Object *cycle_list)
-/* eval_exp == -1 => make it ready, eval_exp == 1 => run exp-time, eval_exp = 0 => don't even make ready */
+                         Scheme_Object *cycle_list, int not_new)
+/* Make an instance of module `m' in `env', which means that phase level 0 of module `m'
+   will be shifted to phase `env->phase'.
+   Let P=`base_phase'-`env->phase'. 
+    - If `eval_run', then instantiate phase-level P of `m' (which is at `base_phase' in `env').
+    - If `eval_exp' is -1, then (also) make its P+1 phase-level ready.
+    - If `eval_exp' is 1, then visit at phase P => run phase P+1. */
 {
   Scheme_Env *menv;
   Scheme_Object *l, *new_cycle_list;
-  int prep_namespace = 0;
+  int prep_namespace = 0, i;
 
   if (is_builtin_modname(m->modname))
     return;
@@ -4503,16 +4584,16 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
 
   new_cycle_list = scheme_make_pair(m->modname, cycle_list);
 
-  menv = instantiate_module(m, env, restart, syntax_idx);
+  menv = instantiate_module(m, env, restart, syntax_idx, not_new);
 
   check_phase(menv, env, 0);
 
-  show("chck", menv, eval_exp, eval_run, base_phase);
+  show("chck", menv, eval_exp, eval_run, 0, base_phase);
 
   if (did_start(menv->did_starts, base_phase, eval_exp, eval_run))
     return;
   
-  show("strt", menv, eval_exp, eval_run, base_phase);
+  show("strt", menv, eval_exp, eval_run, 0, base_phase);
   show_indent(+1);
 
   {
@@ -4530,41 +4611,48 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
     }
   }
 
-  if (env->phase == base_phase) {
-    if (eval_exp) {
-      if (eval_exp > 0) {
-        show("exp=", menv, eval_exp, eval_run, base_phase);
-        expstart_module(menv, env, restart);
+  if (eval_run || eval_exp) {
+    for (i = menv->module->num_phases; i-- ; ) {
+      if (env->phase + i == base_phase) {
+        if (eval_exp) {
+          if (base_phase < menv->module->num_phases) {
+            if (eval_exp > 0) {
+              show("exp=", menv, eval_exp, eval_run, i, base_phase);
+              expstart_module(menv, env, i+1, restart);
+            } else {
+              should_run_for_compile(menv, i);
+            }
+          }
+        }
+        if (eval_run) {
+          show("run=", menv, eval_exp, eval_run, i, base_phase);
+          if (i == 0)
+            do_start_module(m, menv, env, restart);
+          else
+            expstart_module(menv, env, i, restart);
+        }
+      } else if (env->phase + i > base_phase) {
+        if (eval_exp) {
+          should_run_for_compile(menv, i);
+          if (eval_exp > 0) {
+            if (env->phase + i == base_phase + 1) {
+              show("run+", menv, eval_exp, eval_run, i, base_phase);
+              if (i == 0)
+                do_start_module(m, menv, env, restart);
+              else
+                expstart_module(menv, env, i, restart);
+            }
+          }
+        }
       } else {
-        should_run_for_compile(menv);
-      }
-    }
-    if (eval_run) {
-      show("run=", menv, eval_exp, eval_run, base_phase);
-      do_start_module(m, menv, env, restart);
-    }
-  } else if (env->phase < base_phase) {
-    if (env->phase == base_phase - 1) {
-      if (eval_run) {
-        show("run-", menv, eval_exp, eval_run, base_phase);
-        expstart_module(menv, env, restart);
-      }
-    }
-  } else {
-    /* env->phase > base_phase */
-    if (eval_exp) {
-      should_run_for_compile(menv);
-    }
-    if (eval_exp > 0) {
-      if (env->phase == base_phase + 1) {
-        show("run+", menv, eval_exp, eval_run, base_phase);
-        do_start_module(m, menv, env, restart);
+        /* env->phase + i < base_phase */
       }
     }
+
   }
 
   show_indent(-1);
-  show_done("done", menv, eval_exp, eval_run, base_phase);
+  show_done("done", menv, eval_exp, eval_run, 0, base_phase);
 
   if (prep_namespace)
     scheme_prep_namespace_rename(menv);
@@ -4601,9 +4689,9 @@ static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
       menv = (Scheme_Env *)v;
       v = menv->available_next[pos];
       menv->available_next[pos] = NULL;
-      start_module(menv->module, env, 0,
+      start_module(menv->module, menv->instance_env, 0,
                    NULL, 1, 0, base_phase,
-                   scheme_null);
+                   scheme_null, 1);
     }
 
     if (need_lock)
@@ -4711,7 +4799,7 @@ void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env)
   mz_jmp_buf newbuf, * volatile savebuf;
   LOG_RUN_DECLS;
 
-  menv->running = 1;
+  menv->running[0] = 1;
   menv->ran = 1;
 
   depth = m->max_let_depth + scheme_prefix_depth(m->prefix);
@@ -4752,9 +4840,9 @@ void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env)
       scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
     }
 
-    cnt = SCHEME_VEC_SIZE(m->body);
+    cnt = SCHEME_VEC_SIZE(m->bodies[0]);
     for (i = 0; i < cnt; i++) {
-      body = SCHEME_VEC_ELS(m->body)[i];
+      body = SCHEME_VEC_ELS(m->bodies[0])[i];
       if (needs_prompt(body)) {
         /* We need to push the prefix after the prompt is set, so
            restore the runstack and then add the prefix back. */
@@ -4826,6 +4914,7 @@ Scheme_Env *scheme_primitive_module(Scheme_Object *name, Scheme_Env *for_env)
   Scheme_Env *env;
   Scheme_Object *prefix, *insp, *src, *midx;
   Scheme_Config *config;
+  char *running;
 
   m = MALLOC_ONE_TAGGED(Scheme_Module);
   m->so.type = scheme_module_type;
@@ -4880,6 +4969,11 @@ Scheme_Env *scheme_primitive_module(Scheme_Object *name, Scheme_Env *for_env)
 
   scheme_hash_set(for_env->module_registry->loaded, m->modname, (Scheme_Object *)m);
 
+  running = scheme_malloc_atomic(2);
+  running[0] = 0;
+  running[1] = 0;
+  env->running = running;
+
   return env;
 }
 
@@ -4891,6 +4985,9 @@ void scheme_finish_primitive_module(Scheme_Env *env)
   Scheme_Object **exs;
   int i, count;
 
+  if (!m->exp_infos)
+    add_exp_infos(m);
+
   /* Provide all variables: */
   count = 0;
   ht = env->toplevel;
@@ -4918,7 +5015,7 @@ void scheme_finish_primitive_module(Scheme_Env *env)
 
   qsort_provides(exs, NULL, NULL, NULL, NULL, NULL, 0, count, 1);
 
-  env->running = 1;
+  env->running[0] = 1;
 }
 
 void scheme_protect_primitive_provide(Scheme_Env *env, Scheme_Object *name)
@@ -4926,7 +5023,10 @@ void scheme_protect_primitive_provide(Scheme_Env *env, Scheme_Object *name)
   Scheme_Module *m = env->module;
   int i;
 
-  if (!m->provide_protects) {
+  if (!m->exp_infos)
+    add_exp_infos(m);
+
+  if (!m->exp_infos[0]->provide_protects) {
     Scheme_Hash_Table *ht;
     char *exps;
     ht = scheme_make_hash_table(SCHEME_hash_ptr);
@@ -4935,21 +5035,22 @@ void scheme_protect_primitive_provide(Scheme_Env *env, Scheme_Object *name)
       exps[i] = 0;
       scheme_hash_set(ht, m->me->rt->provides[i], scheme_make_integer(i));
     }
-    m->provide_protects = exps;
-    m->accessible = ht;
+    add_exp_infos(m);
+    m->exp_infos[0]->provide_protects = exps;
+    m->exp_infos[0]->accessible = ht;
   }
 
   if (name) {
     for (i = m->me->rt->num_provides; i--; ) {
       if (SAME_OBJ(name, m->me->rt->provides[i])) {
-	m->provide_protects[i] = 1;
+	m->exp_infos[0]->provide_protects[i] = 1;
 	break;
       }
     }
   } else {
     /* Protect all */
     for (i = m->me->rt->num_provides; i--; ) {
-      m->provide_protects[i] = 1;
+      m->exp_infos[0]->provide_protects[i] = 1;
     }
   }
 }
@@ -5052,7 +5153,7 @@ static void *eval_exptime_k(void)
 {
   Scheme_Thread *p = scheme_current_thread;
   Scheme_Object *names;
-  int count, for_stx;
+  int count, at_phase;
   Scheme_Object *expr;
   Scheme_Env *genv;
   Scheme_Comp_Env *comp_env;
@@ -5072,7 +5173,7 @@ static void *eval_exptime_k(void)
   count = p->ku.k.i1;
   let_depth = p->ku.k.i2;
   shift = p->ku.k.i3;
-  for_stx = p->ku.k.i4;
+  at_phase = p->ku.k.i4;
 
   p->ku.k.p1 = NULL;
   p->ku.k.p2 = NULL;
@@ -5080,7 +5181,7 @@ static void *eval_exptime_k(void)
   p->ku.k.p4 = NULL;
   p->ku.k.p5 = NULL;
 
-  eval_exptime(names, count, expr, genv, comp_env, rp, let_depth, shift, syntax, for_stx, 
+  eval_exptime(names, count, expr, genv, comp_env, rp, let_depth, shift, syntax, at_phase, 
                free_id_rename_rn, insp);
 
   return NULL;
@@ -5102,7 +5203,7 @@ static void eval_exptime(Scheme_Object *names, int count,
                          Scheme_Env *genv, Scheme_Comp_Env *comp_env,
                          Resolve_Prefix *rp,
                          int let_depth, int shift, Scheme_Bucket_Table *syntax,
-                         int for_stx,
+                         int at_phase,
                          Scheme_Object *free_id_rename_rn,
                          Scheme_Object *insp)
 {
@@ -5125,7 +5226,7 @@ static void eval_exptime(Scheme_Object *names, int count,
     p->ku.k.i1 = count;
     p->ku.k.i2 = let_depth;
     p->ku.k.i3 = shift;
-    p->ku.k.i4 = for_stx;
+    p->ku.k.i4 = at_phase;
     (void)scheme_enlarge_runstack(depth, eval_exptime_k);
     return;
   }
@@ -5136,7 +5237,7 @@ static void eval_exptime(Scheme_Object *names, int count,
     save_runstack = scheme_push_prefix(genv, rp,
                                        (shift ? genv->module->me->src_modidx : NULL), 
                                        (shift ? genv->link_midx : NULL), 
-                                       1, genv->phase,
+                                       at_phase, genv->phase,
                                        NULL, insp);
 
     if (is_simple_expr(expr)) {
@@ -5162,74 +5263,70 @@ static void eval_exptime(Scheme_Object *names, int count,
     scheme_pop_prefix(save_runstack);
   }
   
-  if (SAME_OBJ(vals, SCHEME_MULTIPLE_VALUES)) {
-    g = scheme_current_thread->ku.multiple.count;
-    if (count == g) {
-      Scheme_Object **values;
+  if (names) {
+    if (SAME_OBJ(vals, SCHEME_MULTIPLE_VALUES)) {
+      g = scheme_current_thread->ku.multiple.count;
+      if (count == g) {
+        Scheme_Object **values;
 
-      values = scheme_current_thread->ku.multiple.array;
-      scheme_current_thread->ku.multiple.array = NULL;
-      if (SAME_OBJ(values, scheme_current_thread->values_buffer))
-	scheme_current_thread->values_buffer = NULL;
-      for (i = 0; i < g; i++, names = SCHEME_CDR(names)) {
-	name = SCHEME_CAR(names);
-
-	if (!for_stx) {
-	  macro = scheme_alloc_small_object();
-	  macro->type = scheme_macro_type;
-	  SCHEME_PTR_VAL(macro) = values[i];
+        values = scheme_current_thread->ku.multiple.array;
+        scheme_current_thread->ku.multiple.array = NULL;
+        if (SAME_OBJ(values, scheme_current_thread->values_buffer))
+          scheme_current_thread->values_buffer = NULL;
+        for (i = 0; i < g; i++, names = SCHEME_CDR(names)) {
+          name = SCHEME_CAR(names);
 
+          macro = scheme_alloc_small_object();
+          macro->type = scheme_macro_type;
+          SCHEME_PTR_VAL(macro) = values[i];
+          
           if (SCHEME_TRUEP(free_id_rename_rn)
               && scheme_is_binding_rename_transformer(values[i]))
             scheme_install_free_id_rename(name, scheme_rename_transformer_id(values[i]), free_id_rename_rn, 
                                           scheme_make_integer(0));
-	} else
-	  macro = values[i];
 	
-	scheme_add_to_table(syntax, (const char *)name, macro, 0);
+          scheme_add_to_table(syntax, (const char *)name, macro, 0);
+        }
+	
+        return;
       }
-	
-      return;
-    }
-  } else if (SCHEME_PAIRP(names) && SCHEME_NULLP(SCHEME_CDR(names))) {
-    name = SCHEME_CAR(names);
+    } else if (SCHEME_PAIRP(names) && SCHEME_NULLP(SCHEME_CDR(names))) {
+      name = SCHEME_CAR(names);
 
-    if (!for_stx) {
       macro = scheme_alloc_small_object();
       macro->type = scheme_macro_type;
       SCHEME_PTR_VAL(macro) = vals;
-
+      
       if (SCHEME_TRUEP(free_id_rename_rn)
           && scheme_is_binding_rename_transformer(vals))
         scheme_install_free_id_rename(name, scheme_rename_transformer_id(vals), free_id_rename_rn, 
                                       scheme_make_integer(0));
-    } else
-      macro = vals;
-
-    scheme_add_to_table(syntax, (const char *)name, macro, 0);
       
-    return;
-  } else
-    g = 1;
+      scheme_add_to_table(syntax, (const char *)name, macro, 0);
+      
+      return;
+    } else
+      g = 1;
   
-  if (count)
-    name = SCHEME_CAR(names);
-  else
-    name = NULL;
+    if (count)
+      name = SCHEME_CAR(names);
+    else
+      name = NULL;
   
-  {
-    const char *symname;
+    {
+      const char *symname;
 
-    symname = (name ? scheme_symbol_name(name) : "");
+      symname = (name ? scheme_symbol_name(name) : "");
 
-    scheme_wrong_return_arity((for_stx ? "define-values-for-syntax" : "define-syntaxes"),
-			      count, g,
-			      (g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array,
-			      "%s%s%s",
-			      name ? "defining \"" : "0 names",
-			      symname,
-			      name ? ((count == 1) ? "\"" : "\", ...") : "");
-  }  
+      scheme_wrong_return_arity("define-syntaxes",
+                                count, g,
+                                (g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array,
+                                "%s%s%s",
+                                name ? "defining \"" : "0 names",
+                                symname,
+                                name ? ((count == 1) ? "\"" : "\", ...") : "");
+    }  
+  }
 }
 
 /**********************************************************************/
@@ -5326,7 +5423,10 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv, i
 
   /* Replacing an already-running or already-syntaxing module? */
   if (old_menv) {
-    start_module(m, env, 1, NULL, old_menv->et_running, old_menv->running, env->phase, scheme_null);
+    start_module(m, env, 1, NULL, 
+                 ((m->num_phases > 1) ? old_menv->running[1] : 0), 
+                 old_menv->running[0], 
+                 env->phase, scheme_null, 1);
   }
 
   return scheme_void;
@@ -5422,26 +5522,39 @@ static Scheme_Object *jit_vector(Scheme_Object *orig_l, int in_vec, int jit)
 static Scheme_Object *do_module_clone(Scheme_Object *data, int jit)
 {
   Scheme_Module *m = (Scheme_Module *)data;
-  Scheme_Object *l1, *l2;
+  Scheme_Object *l1, **naya = NULL;
+  int j, i;
   Resolve_Prefix *rp;
   
   rp = scheme_prefix_eval_clone(m->prefix);
 
-  if (jit)
-    l1 = jit_vector(m->body, 0, jit);
-  else
-    l1 = m->body;
-  l2 = jit_vector(m->et_body, 1, jit);
+  for (j = m->num_phases; j--; ) {
+    if (!jit && !j) {
+      if (naya) 
+        naya[0] = m->bodies[0];
+      break;
+    }
+    l1 = jit_vector(m->bodies[j], j > 0, jit);
+    if (naya)
+      naya[j] = l1;
+    else if (!SAME_OBJ(l1, m->bodies[j])) {
+      naya = MALLOC_N(Scheme_Object*, m->num_phases);
+      for (i = m->num_phases; i-- > j; ) {
+        naya[i] = m->bodies[i];
+      }
+      naya[j] = l1;
+    }
+  }
 
-  if (SAME_OBJ(l1, m->body) 
-      && SAME_OBJ(l2, m->body)
-      && SAME_OBJ(rp, m->prefix))
-    return data;
+  if (!naya) {
+    if (SAME_OBJ(rp, m->prefix))
+      return data;
+    naya = m->bodies;
+  }
   
   m = MALLOC_ONE_TAGGED(Scheme_Module);
   memcpy(m, data, sizeof(Scheme_Module));
-  m->body = l1;
-  m->et_body = l2;
+  m->bodies = naya;
   m->prefix = rp;
 
   return (Scheme_Object *)m;
@@ -5571,7 +5684,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 
   /* load the module for the initial require */
   iim = module_load(_module_resolve(iidx, m->ii_src, NULL, 1), menv, NULL); 
-  start_module(iim, menv, 0, iidx, 1, 0, menv->phase, scheme_null);
+  start_module(iim, menv, 0, iidx, 1, 0, menv->phase, scheme_null, 0);
 
   {
     Scheme_Object *ins;
@@ -5839,7 +5952,7 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name,
   vec = scheme_hash_get(required, name);
   if (vec) {
     Scheme_Object *srcs;
-    char *fromsrc = NULL, *fromsrc_colon = "";
+    char *fromsrc = NULL, *fromsrc_colon = "", *phase_expl;
     intptr_t fromsrclen = 0;
     
     if (same_resolved_modidx(SCHEME_VEC_ELS(vec)[1], modidx)
@@ -5875,8 +5988,21 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name,
       if (err_src)
         srcs = scheme_make_pair(err_src, srcs);
 
+      if (SCHEME_FALSEP(phase))
+        phase_expl = " for label";
+      else if (!SCHEME_INT_VAL(phase))
+        phase_expl = "";
+      else if (SCHEME_INT_VAL(phase) == 1)
+        phase_expl = " for syntax";
+      else {
+        char buf[32];
+        sprintf(buf, " for phase %" PRIxPTR, SCHEME_INT_VAL(phase));
+        phase_expl = scheme_strdup(buf);
+      }
+
       scheme_wrong_syntax_with_more_sources("module", prnt_name, err_src, srcs,
-                                            "identifier already imported from%s %t",
+                                            "identifier already imported%s from%s %t",
+                                            phase_expl,
                                             fromsrc_colon, fromsrc, fromsrclen);
     }
   }
@@ -6018,7 +6144,7 @@ Scheme_Object *scheme_parse_lifted_require(Scheme_Object *module_path,
 
   e = make_require_form(module_path, phase, mark);
 
-  parse_requires(e, base_modidx, env, for_m,
+  parse_requires(e, env->phase, base_modidx, env, for_m,
                  rns, post_ex_rns,
                  check_require_name, tables,
                  redef_modname, 
@@ -6072,33 +6198,15 @@ static void flush_definitions(Scheme_Env *genv)
 static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env *env, 
 				      Scheme_Compile_Expand_Info *rec, int drec)
 {
-  Scheme_Object *form, *fm, *first, *last, *p, *rn_set, *rn, *exp_body, *et_rn, *self_modidx, *prev_p;
-  Scheme_Comp_Env *xenv, *cenv, *rhs_env;
-  Scheme_Hash_Table *et_required; /* just to avoid duplicates */
-  Scheme_Hash_Table *required;    /* name -> (vector nominal-modidx-list modidx srcname var? prntname) */
-  /**/                            /*   first nominal-modidx goes with modidx, rest are for re-provides */
-  Scheme_Hash_Table *provided;    /* exname -> (cons locname-stx-or-sym protected?) */
-  Scheme_Hash_Table *all_reprovided; /* phase -> list of (list modidx syntax except-name ...) */
-  Scheme_Object *all_defs_out;    /* list of (cons protected? (stx-list except-name ...)) */
-  Scheme_Object *all_et_defs_out;
-  Scheme_Hash_Table *all_provided; /* phase -> table like `provided' */
-  Scheme_Object *all_defs;        /* list of stxid; this is almost redundant to the syntax and toplevel
-				     tables, but it preserves the original name for exporting */
-  Scheme_Object *all_et_defs;
-  Scheme_Object *post_ex_rn, *post_ex_et_rn; /* renames for ids introduced by expansion */
+  int num_phases, *_num_phases, i, exicount, *all_simple_renames;
+  Scheme_Hash_Tree *all_defs;
+  Scheme_Hash_Table *tables, *all_defs_out, *all_provided, *all_reprovided, *modidx_cache;
+  Scheme_Module_Export_Info **exp_infos, *exp_info;
+  Scheme_Module_Phase_Exports *pt;
   Scheme_Object *post_ex_rn_set; /* phase -> post_ex_rn-like rename */
-  Scheme_Hash_Table *tables; /* phase -> (vector toplevels requires syntaxes) */
-  Scheme_Object *lift_data;
-  Scheme_Object **exis, **et_exis, **exsis;
-  Scheme_Object *lift_ctx;
-  Scheme_Object *lifted_reqs = scheme_null, *req_data, *unbounds = scheme_null;
-  int exicount, et_exicount, exsicount;
-  char *exps, *et_exps;
-  int *all_simple_renames;
-  int maybe_has_lifts = 0;
-  Scheme_Object *redef_modname;
-  Scheme_Object *observer;
-  Scheme_Hash_Table *modidx_cache;
+  Scheme_Object *form, *redef_modname, *rn_set, *observer, **exis, *body_lists;
+  Scheme_Env *genv;
+  Module_Begin_Expand_State *bxs;
 
   form = scheme_stx_taint_disarm(orig_form, NULL);
 
@@ -6116,138 +6224,361 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
   if (!scheme_hash_get(env->genv->module_registry->loaded, redef_modname))
     redef_modname = NULL;
 
-  /* Expand each expression in form up to `begin', `define-values', `define-syntax', 
-     `require', `provide', `#%app', etc. */
-  xenv = scheme_new_compilation_frame(0, (SCHEME_CAPTURE_WITHOUT_RENAME 
-					  | SCHEME_MODULE_BEGIN_FRAME
-					  | SCHEME_FOR_STOPS), 
-				      env);
-  {
-    Scheme_Object *stop;
-    stop = scheme_get_stop_expander();
-    scheme_add_local_syntax(19, xenv);
-    scheme_set_local_syntax(0, scheme_begin_stx, stop, xenv);
-    scheme_set_local_syntax(1, scheme_define_values_stx, stop, xenv);
-    scheme_set_local_syntax(2, scheme_define_syntaxes_stx, stop, xenv);
-    scheme_set_local_syntax(3, scheme_define_for_syntaxes_stx, stop, xenv);
-    scheme_set_local_syntax(4, require_stx, stop, xenv);
-    scheme_set_local_syntax(5, provide_stx, stop, xenv);
-    scheme_set_local_syntax(6, set_stx, stop, xenv);
-    scheme_set_local_syntax(7, app_stx, stop, xenv);
-    scheme_set_local_syntax(8, scheme_top_stx, stop, xenv);
-    scheme_set_local_syntax(9, lambda_stx, stop, xenv);
-    scheme_set_local_syntax(10, case_lambda_stx, stop, xenv);
-    scheme_set_local_syntax(11, let_values_stx, stop, xenv);
-    scheme_set_local_syntax(12, letrec_values_stx, stop, xenv);
-    scheme_set_local_syntax(13, if_stx, stop, xenv);
-    scheme_set_local_syntax(14, begin0_stx, stop, xenv);
-    scheme_set_local_syntax(15, with_continuation_mark_stx, stop, xenv);
-    scheme_set_local_syntax(16, letrec_syntaxes_stx, stop, xenv);
-    scheme_set_local_syntax(17, var_ref_stx, stop, xenv);
-    scheme_set_local_syntax(18, expression_stx, stop, xenv);
-  }
+  tables = scheme_make_hash_table_equal();
 
-  first = scheme_null;
-  last = NULL;
+  modidx_cache = scheme_make_hash_table_equal();
 
   rn_set = env->genv->rename_set;
-  rn = scheme_get_module_rename_from_set(rn_set, scheme_make_integer(0), 1);
-  et_rn = scheme_get_module_rename_from_set(rn_set, scheme_make_integer(1), 1);
-
-  required = scheme_make_hash_table(SCHEME_hash_ptr);
-  et_required = scheme_make_hash_table(SCHEME_hash_ptr);
-
-  tables = scheme_make_hash_table_equal();
-  {
-    Scheme_Object *vec;
-
-    vec = scheme_make_vector(3, NULL);
-    SCHEME_VEC_ELS(vec)[0] = (Scheme_Object *)env->genv->toplevel;
-    SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)required;
-    SCHEME_VEC_ELS(vec)[2] = (Scheme_Object *)env->genv->syntax;
-    scheme_hash_set(tables, scheme_make_integer(0), vec);
-
-    vec = scheme_make_vector(3, NULL);
-    SCHEME_VEC_ELS(vec)[0] = (Scheme_Object *)env->genv->exp_env->toplevel;
-    SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)et_required;
-    SCHEME_VEC_ELS(vec)[2] = NULL;
-    scheme_hash_set(tables, scheme_make_integer(1), vec);
-  }
-
-  /* Put initial requires into the table:
-     (This is redundant for the rename set, but we need to fill
-     the `all_requires' table, etc.) */
-  modidx_cache = scheme_make_hash_table_equal();
-  {
-    Scheme_Module *iim;
-    Scheme_Object *nmidx, *orig_src;
-
-    /* stx src of original import: */
-    orig_src = env->genv->module->ii_src;
-    if (!orig_src)
-      orig_src = scheme_false;
-    else if (!SCHEME_STXP(orig_src))
-      orig_src = scheme_false;
-    
-    nmidx = SCHEME_CAR(env->genv->module->requires);
-    iim = module_load(scheme_module_resolve(nmidx, 1), env->genv, NULL);
-
-    add_simple_require_renames(orig_src, rn_set, tables, 
-                               iim, nmidx,
-                               scheme_make_integer(0),
-                               NULL, 1);
-
-    scheme_hash_set(modidx_cache, ((Scheme_Modidx *)nmidx)->path, nmidx);
-  }
-
   {
     Scheme_Object *v;
     v = scheme_rename_to_stx(rn_set);
     env->genv->module->rn_stx = v;
   }
 
-  provided = scheme_make_hash_table(SCHEME_hash_ptr);
   all_provided = scheme_make_hash_table_equal();
-  scheme_hash_set(all_provided, scheme_make_integer(0), (Scheme_Object *)provided);
-
   all_reprovided = scheme_make_hash_table_equal();
+  all_defs = scheme_make_hash_tree(1);
+  all_defs_out = scheme_make_hash_table_equal();
 
-  all_defs_out = scheme_null;
-  all_et_defs_out = scheme_null;
+  post_ex_rn_set = scheme_make_module_rename_set(mzMOD_RENAME_MARKED, rn_set, env->genv->module->insp);
 
-  all_defs = scheme_null;
-  all_et_defs = scheme_null;
+  /* It's possible that #%module-begin expansion introduces
+     marked identifiers for definitions. */
+  form = scheme_add_rename(form, post_ex_rn_set);
 
-  exp_body = scheme_null;
+  observer = rec[drec].observer;
+  SCHEME_EXPAND_OBSERVE_RENAME_ONE(observer, form);
+
+  _num_phases = MALLOC_ONE_ATOMIC(int);
+  *_num_phases = 0;
+
+  all_simple_renames = (int *)scheme_malloc_atomic(sizeof(int));
+  *all_simple_renames = 1;
+
+  bxs = scheme_malloc(sizeof(Module_Begin_Expand_State));
+  bxs->post_ex_rn_set = post_ex_rn_set;
+  bxs->tables = tables;
+  bxs->all_provided = all_provided;
+  bxs->all_reprovided = all_reprovided;
+  bxs->all_defs = all_defs;
+  bxs->all_defs_out = all_defs_out;
+  bxs->all_simple_renames = all_simple_renames;
+  bxs->_num_phases = _num_phases;
+  bxs->saved_provides = scheme_null;
+  bxs->modidx_cache = modidx_cache;
+  bxs->redef_modname = redef_modname;
+
+  body_lists = do_module_begin_at_phase(form, env, 
+                                        rec, drec, 
+                                        rec[drec].comp ? NULL : rec, drec, 
+                                        0, 
+                                        scheme_null,
+                                        bxs);
+  num_phases = *_num_phases;
+
+  /* Compute provides for re-provides and all-defs-out: */
+  (void)compute_reprovides(all_provided,
+                           all_reprovided, 
+                           env->genv->module, 
+                           tables,
+                           env->genv, 
+                           num_phases,
+                           bxs->all_defs, all_defs_out, 
+                           "require", NULL, NULL);
+
+  exp_infos = MALLOC_N(Scheme_Module_Export_Info*, num_phases);
+  for (i = 0; i < num_phases; i++) {
+    exp_info = MALLOC_ONE_RT(Scheme_Module_Export_Info);
+    SET_REQUIRED_TAG(exp_info->type = scheme_rt_export_info);
+    exp_infos[i] = exp_info;
+  }
+
+  /* Compute provide arrays */
+  compute_provide_arrays(all_provided, tables,
+                         env->genv->module->me,
+                         env->genv,
+                         form, 
+                         num_phases, exp_infos);
+  
+  /* Compute indirect provides (which is everything at the top-level): */
+  genv = env->genv;
+  for (i = 0; i < num_phases; i++) {
+    switch (i) {
+    case 0:
+      pt = env->genv->module->me->rt;
+      break;
+    case 1:
+      pt = env->genv->module->me->et;
+      break;
+    default:
+      if (env->genv->module->me->other_phases)
+        pt = (Scheme_Module_Phase_Exports *)scheme_hash_get(env->genv->module->me->other_phases,
+                                                            scheme_make_integer(i));
+      else 
+        pt = NULL;
+      break;
+    }
+    if (pt) {
+      exis = compute_indirects(genv, pt, &exicount, 1);
+      exp_infos[i]->indirect_provides = exis;
+      exp_infos[i]->num_indirect_provides = exicount;
+      exis = compute_indirects(genv, pt, &exicount, 0);
+      exp_infos[i]->indirect_syntax_provides = exis;
+      exp_infos[i]->num_indirect_syntax_provides = exicount;
+    }
+    genv = genv->exp_env;
+  }
+
+  if (rec[drec].comp || (rec[drec].depth != -2)) {
+    scheme_clean_dead_env(env->genv);
+  }
+
+  if (!rec[drec].comp) {
+    Scheme_Module_Phase_Exports *rt = env->genv->module->me->rt;
+    int excount = rt->num_provides;
+    int exvcount = rt->num_var_provides;
+    Scheme_Object **exsns = rt->provide_src_names;
+    Scheme_Object **exs = rt->provides;
+    Scheme_Object **exss = rt->provide_srcs;
+
+    /* Produce annotations (in the form of properties)
+       for module information:
+         'module-variable-provides = '(item ...)
+         'module-syntax-provides = '(item ...)
+	 'module-indirect-provides = '(id ...)
+         'module-kernel-reprovide-hint = 'kernel-reexport
+
+      item = name
+           | (ext-id . def-id)
+           | (modidx ext-id . def-id)
+     kernel-reexport = #f
+                     | #t
+                     | exclusion-id
+    */
+    int j;
+    Scheme_Object *e, *a, *result;
+
+    result = scheme_null;
+
+    /* kernel re-export info (always #f): */
+    result = scheme_make_pair(scheme_false, result);
+
+    /* Indirect provides */ 
+    a = scheme_null;
+    for (j = 0; j < exp_infos[0]->num_indirect_provides; j++) {
+      a = scheme_make_pair(exp_infos[0]->indirect_provides[j], a);
+    }
+    result = scheme_make_pair(a, result);
+    
+    /* add syntax and value exports: */
+    for (j = 0; j < 2; j++) {
+      int top, i;
+
+      e = scheme_null;
+
+      if (!j) {
+	i = exvcount;
+	top = excount;
+      } else {
+	i = 0;
+	top = exvcount;
+      }
+      
+      for (; i < top; i++) {
+	if (SCHEME_FALSEP(exss[i])
+	    && SAME_OBJ(exs[i], exsns[i]))
+	  a = exs[i];
+	else {
+	  a = scheme_make_pair(exs[i], exsns[i]);
+	  if (!SCHEME_FALSEP(exss[i])) {
+	    a = scheme_make_pair(exss[i], a);
+	  }
+	}
+	e = scheme_make_pair(a, e);
+      }
+      result = scheme_make_pair(e, result);
+    }
+
+    env->genv->module->hints = result;
+  }
+
+  if (rec[drec].comp) {
+    Scheme_Object *a, **bodies;
+
+    bodies = MALLOC_N(Scheme_Object*, num_phases);
+    for (i = 0; i < num_phases; i++) {
+      a = SCHEME_CAR(body_lists);
+      if (i > 0) a = scheme_reverse(a);
+      a = scheme_list_to_vector(a);
+      bodies[i] = a;
+      body_lists = SCHEME_CDR(body_lists);
+    }
+    env->genv->module->bodies = bodies;
+    env->genv->module->num_phases = num_phases;
+
+    env->genv->module->exp_infos = exp_infos;
+
+    if (!*all_simple_renames) {
+      /* No need to keep indirect syntax provides */
+      for (i = 0; i < num_phases; i++) {
+        exp_infos[i]->indirect_syntax_provides = NULL;
+        exp_infos[i]->num_indirect_syntax_provides = 0;
+      }
+    }
+
+    if (*all_simple_renames) {
+      env->genv->module->rn_stx = scheme_true;
+    }
+
+    return (Scheme_Object *)env->genv->module;
+  } else {
+    Scheme_Object *p;
+
+    if (rec[drec].depth == -2) {
+      /* This was a local expand. Flush definitions, because the body expand may start over. */
+      flush_definitions(env->genv);
+      if (env->genv->exp_env)
+        flush_definitions(env->genv->exp_env);
+    }
+
+    p = SCHEME_STX_CAR(form);
+
+    return scheme_datum_to_syntax(cons(p, body_lists), orig_form, orig_form, 0, 2);
+  }
+}
+
+#define DONE_MODFORM_KIND 0
+#define EXPR_MODFORM_KIND 1
+#define DEFN_MODFORM_KIND 2
+#define PROVIDE_MODFORM_KIND 3
+#define SAVED_MODFORM_KIND 4
+
+static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_Env *env, 
+                                               Scheme_Compile_Expand_Info *rec, int drec,
+                                               Scheme_Compile_Expand_Info *erec, int derec,
+                                               int phase, 
+                                               Scheme_Object *body_lists, /* starts from phase + 1; null in expand mode */
+                                               Module_Begin_Expand_State *bxs)
+/* Result in expand mode is expressions in order.
+   Result in compile mode is a body_lists starting with `phase',
+   where a body_lists has each phase in order, with each list after the first in reverse order.
+   If both rec[drec].comp && erec, cons results.
+   If !rec[drec].comp, then erec is non-NULL. */
+{
+  Scheme_Object *fm, *first, *last, *p, *rn_set, *rn, *exp_body, *self_modidx, *prev_p;
+  Scheme_Object *expanded_l;
+  Scheme_Comp_Env *xenv, *cenv, *rhs_env;
+  Scheme_Hash_Table *required;    /* name -> (vector nominal-modidx-list modidx srcname var? prntname)
+                                     first nominal-modidx goes with modidx, rest are for re-provides */
+  Scheme_Hash_Table *provided;    /* exname -> (cons locname-stx-or-sym protected?) */
+  Scheme_Object *all_rt_defs;        /* list of stxid; this is almost redundant to the syntax and toplevel
+                                        tables, but it preserves the original name for exporting */
+  Scheme_Hash_Tree *adt;
+  Scheme_Object *post_ex_rn;     /* renames for ids introduced by expansion */
+  Scheme_Object *lift_data;
+  Scheme_Object *lift_ctx;
+  Scheme_Object *lifted_reqs = scheme_null, *req_data, *unbounds = scheme_null;
+  int maybe_has_lifts = 0;
+  Scheme_Object *observer, *vec;
+  Scheme_Object *define_values_stx, *begin_stx, *define_syntaxes_stx, *begin_for_syntax_stx, *req_stx, *prov_stx, *sv[6];
+  
+  if (*bxs->_num_phases < phase + 1)
+    *bxs->_num_phases = phase + 1;
+
+  /* Expand each expression in form up to `begin', `define-values', `define-syntax', 
+     `require', `provide', `#%app', etc. */
+  xenv = scheme_new_compilation_frame(0, (SCHEME_CAPTURE_WITHOUT_RENAME 
+					  | SCHEME_MODULE_BEGIN_FRAME
+					  | SCHEME_FOR_STOPS), 
+				      env);
+
+  install_stops(xenv, phase, sv);
+
+  define_values_stx = sv[0];
+  begin_stx = sv[1];
+  define_syntaxes_stx = sv[2];
+  begin_for_syntax_stx = sv[3];
+  req_stx = sv[4];
+  prov_stx = sv[5];
+  
+  first = scheme_null;
+  last = NULL;
+
+  rn_set = env->genv->rename_set;
+  rn = scheme_get_module_rename_from_set(rn_set, scheme_make_integer(phase), 1);
+
+  vec = scheme_hash_get(bxs->tables, scheme_make_integer(phase));
+  if (!vec) {
+    required = scheme_make_hash_table(SCHEME_hash_ptr);
+    vec = scheme_make_vector(3, NULL);
+    SCHEME_VEC_ELS(vec)[0] = (Scheme_Object *)env->genv->toplevel;
+    SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)required;
+    SCHEME_VEC_ELS(vec)[2] = (Scheme_Object *)env->genv->syntax;
+    scheme_hash_set(bxs->tables, scheme_make_integer(phase), vec);
+  } else
+    required = (Scheme_Hash_Table *)SCHEME_VEC_ELS(vec)[1];
+
+  if (phase == 0) {
+    /* Put initial requires into the table:
+       (This is redundant for the rename set, but we need to fill
+       the `all_requires' table, etc.) */
+    {
+      Scheme_Module *iim;
+      Scheme_Object *nmidx, *orig_src;
+
+      /* stx src of original import: */
+      orig_src = env->genv->module->ii_src;
+      if (!orig_src)
+        orig_src = scheme_false;
+      else if (!SCHEME_STXP(orig_src))
+        orig_src = scheme_false;
+    
+      nmidx = SCHEME_CAR(env->genv->module->requires);
+      iim = module_load(scheme_module_resolve(nmidx, 1), env->genv, NULL);
+
+      add_simple_require_renames(orig_src, rn_set, bxs->tables, 
+                                 iim, nmidx,
+                                 scheme_make_integer(0),
+                                 NULL, 1);
+
+      scheme_hash_set(bxs->modidx_cache, ((Scheme_Modidx *)nmidx)->path, nmidx);
+    }
+  }
+
+  provided = (Scheme_Hash_Table *)scheme_hash_get(bxs->all_provided, scheme_make_integer(phase));
+  if (!provided) {
+    provided = scheme_make_hash_table(SCHEME_hash_ptr);
+    scheme_hash_set(bxs->all_provided, scheme_make_integer(phase), (Scheme_Object *)provided);
+  }
+
+  all_rt_defs = scheme_hash_tree_get(bxs->all_defs, scheme_make_integer(phase));
+  if (!all_rt_defs) all_rt_defs = scheme_null;
+
+  if (SCHEME_NULLP(body_lists))
+    exp_body = scheme_null;
+  else {
+    exp_body = SCHEME_CAR(body_lists);
+    body_lists = SCHEME_CDR(body_lists);
+  }
 
   self_modidx = env->genv->module->self_modidx;
 
-  post_ex_rn_set = scheme_make_module_rename_set(mzMOD_RENAME_MARKED, rn_set, env->genv->module->insp);
-  post_ex_rn = scheme_get_module_rename_from_set(post_ex_rn_set, scheme_make_integer(0), 1);
-  post_ex_et_rn = scheme_get_module_rename_from_set(post_ex_rn_set, scheme_make_integer(1), 1);
-  env->genv->post_ex_rename_set = post_ex_rn_set;
+  post_ex_rn = scheme_get_module_rename_from_set(bxs->post_ex_rn_set, scheme_make_integer(phase), 1);
+  env->genv->post_ex_rename_set = bxs->post_ex_rn_set;
 
   /* For syntax-local-context, etc., in a d-s RHS: */
   rhs_env = scheme_new_comp_env(env->genv, env->insp, SCHEME_TOPLEVEL_FRAME);
 
   observer = rec[drec].observer;
 
-  /* It's possible that #%module-begin expansion introduces
-     marked identifiers for definitions. */
-  form = scheme_add_rename(form, post_ex_rn_set);
-  SCHEME_EXPAND_OBSERVE_RENAME_ONE(observer, form);
-
   maybe_has_lifts = 0;
   lift_ctx = scheme_generate_lifts_key();
 
-  all_simple_renames = (int *)scheme_malloc_atomic(sizeof(int));
-  *all_simple_renames = 1;
-
   req_data = package_require_data(self_modidx, env->genv, env->genv->module,
-                                  rn_set, post_ex_rn_set,
-                                  tables,
-                                  redef_modname, 
-                                  all_simple_renames);
+                                  rn_set, bxs->post_ex_rn_set,
+                                  bxs->tables,
+                                  bxs->redef_modname, 
+                                  bxs->all_simple_renames);
 
   /* Pass 1 */
 
@@ -6292,10 +6623,10 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
       if (!SCHEME_NULLP(fst)) {
 	/* Expansion lifted expressions, so add them to
 	   the front and try again. */
-        *all_simple_renames = 0;
+        *bxs->all_simple_renames = 0;
 	fm = SCHEME_STX_CDR(fm);
-        e = scheme_add_rename(e, post_ex_rn_set);
-        fm = scheme_named_map_1(NULL, add_a_rename, fm, post_ex_rn_set);
+        e = scheme_add_rename(e, bxs->post_ex_rn_set);
+        fm = scheme_named_map_1(NULL, add_a_rename, fm, bxs->post_ex_rn_set);
         fm = scheme_make_pair(e, fm);
         SCHEME_EXPAND_OBSERVE_RENAME_LIST(observer, fm);
 	fm = scheme_append(fst, fm);
@@ -6307,9 +6638,9 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 	else
 	  fst = NULL;
 	
-	if (fst && SCHEME_STX_SYMBOLP(fst) && scheme_stx_module_eq(scheme_begin_stx, fst, 0)) {
+	if (fst && SCHEME_STX_SYMBOLP(fst) && scheme_stx_module_eq(begin_stx, fst, phase)) {
 	  fm = SCHEME_STX_CDR(fm);
-	  e = scheme_add_rename(e, post_ex_rn_set);
+	  e = scheme_add_rename(e, bxs->post_ex_rn_set);
           SCHEME_EXPAND_OBSERVE_RENAME_ONE(observer, e);
 	  fm = scheme_flatten_begin(e, fm);
 	  SCHEME_EXPAND_OBSERVE_SPLICE(observer, fm);
@@ -6333,7 +6664,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
     }
     if (!e) break; /* (begin) expansion at end */
 
-    e = scheme_add_rename(e, post_ex_rn_set);
+    e = scheme_add_rename(e, bxs->post_ex_rn_set);
 
     SCHEME_EXPAND_OBSERVE_RENAME_ONE(observer, e);
     
@@ -6346,7 +6677,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 
 	Scheme_Object *n;
 	n = SCHEME_STX_CAR(e);
-	if (scheme_stx_module_eq(scheme_define_values_stx, fst, 0)) {
+	if (scheme_stx_module_eq(define_values_stx, fst, phase)) {
 	  /************ define-values *************/
 	  Scheme_Object *vars, *val;
 
@@ -6364,7 +6695,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 	    orig_name = name;
 
 	    /* Remember the original: */
-	    all_defs = scheme_make_pair(name, all_defs);
+	    all_rt_defs = scheme_make_pair(name, all_rt_defs);
 	    
 	    name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL, NULL);
 
@@ -6391,21 +6722,21 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 
 	    /* Add a renaming: */
 	    if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) {
-	      scheme_extend_module_rename(post_ex_rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0);
-              *all_simple_renames = 0;
+	      scheme_extend_module_rename(post_ex_rn, self_modidx, name, name, self_modidx, name, phase, NULL, NULL, 0);
+              *bxs->all_simple_renames = 0;
 	    } else
-	      scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0);
+	      scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, phase, NULL, NULL, 0);
 
 	    vars = SCHEME_STX_CDR(vars);
 	  }
           
           SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
-	  kind = 2;
-	} else if (scheme_stx_module_eq(scheme_define_syntaxes_stx, fst, 0)
-		   || scheme_stx_module_eq(scheme_define_for_syntaxes_stx, fst, 0)) {
-	  /************ define-syntaxes & define-values-for-syntax *************/
+	  kind = DEFN_MODFORM_KIND;
+        } else if (scheme_stx_module_eq(define_syntaxes_stx, fst, phase)
+                   || scheme_stx_module_eq(begin_for_syntax_stx, fst, phase)) {
+	  /************ define-syntaxes & begin-for-syntax *************/
 	  /* Define the macro: */
-	  Scheme_Compile_Info mrec;
+	  Scheme_Compile_Info mrec, erec1;
 	  Scheme_Object *names, *l, *code, *m, *vec, *boundname;
 	  Resolve_Prefix *rp;
 	  Resolve_Info *ri;
@@ -6416,79 +6747,80 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
           int use_post_ex = 0;
           int max_let_depth;
 
-	  for_stx = scheme_stx_module_eq(scheme_define_for_syntaxes_stx, fst, 0);
-
+	  for_stx = scheme_stx_module_eq(begin_for_syntax_stx, fst, phase);
+          
           SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e);
           SCHEME_EXPAND_OBSERVE_PRIM_DEFINE_SYNTAXES(observer);
 
-	  scheme_define_parse(e, &names, &code, 1, env, 1);
+          if (for_stx) {
+            if (scheme_stx_proper_list_length(e) < 0)
+              scheme_wrong_syntax(NULL, NULL, e, NULL);
+            code = e;
+          } else
+            scheme_define_parse(e, &names, &code, 1, env, 1);
 
-	  if (SCHEME_STX_PAIRP(names) && SCHEME_STX_NULLP(SCHEME_STX_CDR(names)))
-	    boundname = SCHEME_STX_CAR(names);
-	  else
-	    boundname = scheme_false;
+          if (!for_stx && SCHEME_STX_PAIRP(names) && SCHEME_STX_NULLP(SCHEME_STX_CDR(names)))
+            boundname = SCHEME_STX_CAR(names);
+          else
+            boundname = scheme_false;
 	  
 	  scheme_prepare_exp_env(env->genv);
 	  scheme_prepare_compile_env(env->genv->exp_env);
 	  eenv = scheme_new_comp_env(env->genv->exp_env, env->insp, 0);
-          scheme_frame_captures_lifts(eenv, NULL, NULL, scheme_false, scheme_false, 
-                                      req_data, scheme_false);
+          if (!for_stx)
+            scheme_frame_captures_lifts(eenv, NULL, NULL, scheme_false, scheme_false, 
+                                        req_data, scheme_false);
 
-	  oenv = (for_stx ? eenv : env);
+	  oenv = env;
 	  
-	  for (l = names; SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) {
-	    Scheme_Object *name, *orig_name;
-	    name = SCHEME_STX_CAR(l);
+          if (!for_stx) {
+            for (l = names; SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) {
+              Scheme_Object *name, *orig_name;
+              name = SCHEME_STX_CAR(l);
 
-	    orig_name = name;
+              orig_name = name;
 
-            /* Remember the original: */
-	    if (!for_stx)
-	      all_defs = scheme_make_pair(name, all_defs);
-            else
-              all_et_defs = scheme_make_pair(name, all_et_defs);
+              /* Remember the original: */
+              all_rt_defs = scheme_make_pair(name, all_rt_defs);
 	    
-	    name = scheme_tl_id_sym(oenv->genv, name, NULL, 2, NULL, NULL);
+              name = scheme_tl_id_sym(oenv->genv, name, NULL, 2, NULL, NULL);
 	    
-	    if (scheme_lookup_in_table(oenv->genv->syntax, (const char *)name)) {
-	      scheme_wrong_syntax("module", orig_name, e, 
-				  (for_stx
-				   ? "duplicate for-syntax definition for identifier"
-				   : "duplicate definition for identifier"));
-	      return NULL;
-	    }
+              if (scheme_lookup_in_table(oenv->genv->syntax, (const char *)name)) {
+                scheme_wrong_syntax("module", orig_name, e, 
+                                    "duplicate definition for identifier");
+                return NULL;
+              }
 	    
-	    /* Check that it's not yet defined: */
-	    if (scheme_lookup_in_table(oenv->genv->toplevel, (const char *)name)) {
-	      scheme_wrong_syntax("module", orig_name, e, 
-				  (for_stx
-				   ? "duplicate for-syntax definition for identifier"
-				   : "duplicate definition for identifier"));
-	      return NULL;
-	    }
+              /* Check that it's not yet defined: */
+              if (scheme_lookup_in_table(oenv->genv->toplevel, (const char *)name)) {
+                scheme_wrong_syntax("module", orig_name, e, 
+                                    "duplicate definition for identifier");
+                return NULL;
+              }
 
-	    /* Not required: */
-	    if (check_already_required(for_stx ? et_required : required, name)) {
-	      scheme_wrong_syntax("module", orig_name, e, 
-				  (for_stx
-				   ? "identifier is already imported for syntax"
-				   : "identifier is already imported"));
-	      return NULL;
-	    }
+              /* Not required: */
+              if (check_already_required(required, name)) {
+                scheme_wrong_syntax("module", orig_name, e, "identifier is already imported");
+                return NULL;
+              }
 
-	    if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) {
-	      scheme_extend_module_rename(for_stx ? post_ex_et_rn : post_ex_rn, self_modidx, name, name, self_modidx, name,
-					  for_stx ? 1 : 0, NULL, NULL, 0);
-              *all_simple_renames = 0;
-              use_post_ex = 1;
-	    } else
-	      scheme_extend_module_rename(for_stx ? et_rn : rn, self_modidx, name, name, self_modidx, name,
-					  for_stx ? 1 : 0, NULL, NULL, 0);
+              if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) {
+                scheme_extend_module_rename(post_ex_rn, self_modidx, name, name, self_modidx, name,
+                                            phase, NULL, NULL, 0);
+                *bxs->all_simple_renames = 0;
+                use_post_ex = 1;
+              } else
+                scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name,
+                                            phase, NULL, NULL, 0);
 
-	    count++;
-	  }
+              count++;
+            }
+          }
 
-	  names = scheme_named_map_1(NULL, stx_sym, names, (Scheme_Object *)oenv->genv);
+          if (for_stx)
+            names = NULL;
+          else
+            names = scheme_named_map_1(NULL, stx_sym, names, (Scheme_Object *)oenv->genv);
 	  
 	  mrec.comp = 1;
 	  mrec.dont_mark_local_use = 0;
@@ -6499,21 +6831,50 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
           mrec.env_already = 0;
           mrec.comp_flags = rec[drec].comp_flags;
 
-	  if (!rec[drec].comp) {
-	    Scheme_Expand_Info erec1;
-	    erec1.comp = 0;
-	    erec1.depth = -1;
-	    erec1.value_name = boundname;
+          if (erec) {
+            erec1.comp = 0;
+            erec1.depth = -1;
+            erec1.value_name = boundname;
             erec1.observer = rec[drec].observer;
             erec1.pre_unwrapped = 0;
             erec1.env_already = 0;
             erec1.comp_flags = rec[drec].comp_flags;
-	    SCHEME_EXPAND_OBSERVE_PHASE_UP(observer);
-	    code = scheme_expand_expr_lift_to_let(code, eenv, &erec1, 0);
-	  }
-	  m = scheme_compile_expr_lift_to_let(code, eenv, &mrec, 0);
+          }
 
-          lifted_reqs = scheme_append(scheme_frame_get_require_lifts(eenv), lifted_reqs);
+	  if (for_stx) {
+            adt = scheme_hash_tree_set(bxs->all_defs, scheme_make_integer(phase), all_rt_defs);
+            bxs->all_defs = adt;
+            if (erec) {
+              SCHEME_EXPAND_OBSERVE_PHASE_UP(observer); /* FIXME [Ryan?]? */
+              /* We expand & compile the for-syntax code in one pass. */
+            }
+            m = do_module_begin_at_phase(code, eenv, 
+                                         &mrec, 0, 
+                                         (erec ? &erec1 : NULL), 0,
+                                         phase + 1, body_lists,
+                                         bxs);
+            if (erec) {
+              code = SCHEME_STX_CAR(code);
+              code = scheme_make_pair(code, SCHEME_CAR(m));
+              m = SCHEME_CDR(m);
+            }
+            if (rec[drec].comp)
+              body_lists = SCHEME_CDR(m);
+            m = SCHEME_CAR(m);
+            /* turn list of compiled expressions into a splice: */
+            m = scheme_make_sequence_compilation(m, 0);
+            if (m->type == scheme_sequence_type)
+              m->type = scheme_splice_sequence_type;
+          } else {
+            if (erec) {
+              SCHEME_EXPAND_OBSERVE_PHASE_UP(observer);
+              code = scheme_expand_expr_lift_to_let(code, eenv, &erec1, 0);
+            }
+            m = scheme_compile_expr_lift_to_let(code, eenv, &mrec, 0);
+          }
+
+          if (!for_stx)
+            lifted_reqs = scheme_append(scheme_frame_get_require_lifts(eenv), lifted_reqs);
 
 	  oi = scheme_optimize_info_create();
           scheme_optimize_info_set_context(oi, (Scheme_Object *)env->genv->module);
@@ -6533,9 +6894,11 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 
 	  /* Add code with names and lexical depth to exp-time body: */
 	  vec = scheme_make_vector(5, NULL);
-	  SCHEME_VEC_ELS(vec)[0] = ((SCHEME_PAIRP(names) && SCHEME_NULLP(SCHEME_CDR(names)))
-                                    ? SCHEME_CAR(names)
-                                    : names);
+	  SCHEME_VEC_ELS(vec)[0] = (for_stx
+                                    ? scheme_false
+                                    : ((SCHEME_PAIRP(names) && SCHEME_NULLP(SCHEME_CDR(names)))
+                                       ? SCHEME_CAR(names)
+                                       : names));
 	  SCHEME_VEC_ELS(vec)[1] = m;
           SCHEME_VEC_ELS(vec)[2] = scheme_make_integer(max_let_depth);
 	  SCHEME_VEC_ELS(vec)[3] = (Scheme_Object *)rp;
@@ -6551,52 +6914,59 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
           rp = scheme_prefix_eval_clone(rp);
           
 	  eval_exptime(names, count, m, eenv->genv, rhs_env, rp, max_let_depth, 0, 
-                       (for_stx ? env->genv->exp_env->toplevel : env->genv->syntax), for_stx,
+                       (for_stx ? env->genv->exp_env->toplevel : env->genv->syntax), 
+                       phase + 1,
                        for_stx ? scheme_false : (use_post_ex ? post_ex_rn : rn),
                        NULL);
           
-	  if (rec[drec].comp)
-	    e = NULL;
-	  else {
-	    m = SCHEME_STX_CDR(e);
-	    m = SCHEME_STX_CAR(m);
-	    m = scheme_make_pair(fst,
-				 scheme_make_pair(m, scheme_make_pair(code, scheme_null)));
+	  if (erec) {
+            if (for_stx) {
+              m = code;
+            } else {
+              m = SCHEME_STX_CDR(e);
+              m = SCHEME_STX_CAR(m);
+              m = scheme_make_pair(fst,
+                                   scheme_make_pair(m, scheme_make_pair(code, scheme_null)));
+            }
 	    e = scheme_datum_to_syntax(m, e, e, 0, 2);
-	  }
+	  } else
+            e = NULL;
           
           SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
-	  kind = 0;
-	} else if (scheme_stx_module_eq(require_stx, fst, 0)) {	
+
+          kind = DONE_MODFORM_KIND;
+	} else if (scheme_stx_module_eq(req_stx, fst, phase)) {	
 	  /************ require *************/
           SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e);
           SCHEME_EXPAND_OBSERVE_PRIM_REQUIRE(observer);
 
 	  /* Adds requires to renamings and required modules to requires lists: */
-	  parse_requires(e, self_modidx, env->genv, env->genv->module,
-                         rn_set, post_ex_rn_set,
-                         check_require_name, tables,
-                         redef_modname, 
+	  parse_requires(e, phase, self_modidx, env->genv, env->genv->module,
+                         rn_set, bxs->post_ex_rn_set,
+                         check_require_name, bxs->tables,
+                         bxs->redef_modname, 
                          0, 0, 1, 
-                         1, 0,
-                         all_simple_renames, modidx_cache);
+                         1, phase ? 1 : 0,
+                         bxs->all_simple_renames, bxs->modidx_cache);
 
-	  if (rec[drec].comp)
+	  if (!erec)
 	    e = NULL;
 
           SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
-	  kind = 0;
-	} else if (scheme_stx_module_eq(provide_stx, fst, 0)) {
+	  kind = DONE_MODFORM_KIND;
+	} else if (scheme_stx_module_eq(prov_stx, fst, phase)) {
 	  /************ provide *************/
-          /* remember it for the second pass */
-          kind = 3;
-	} else {
-	  kind = 1;
-        }
+          /* remember it for pass 3 */
+          p = scheme_make_pair(scheme_make_pair(e, scheme_make_integer(phase)),
+                               bxs->saved_provides);
+          bxs->saved_provides = p;
+          kind = PROVIDE_MODFORM_KIND;
+	} else
+	  kind = EXPR_MODFORM_KIND;
       } else
-	kind = 1;
+	kind = EXPR_MODFORM_KIND;
     } else
-      kind = 1;
+      kind = EXPR_MODFORM_KIND;
 
     if (e) {
       p = scheme_make_pair(scheme_make_pair(e, scheme_make_integer(kind)), scheme_null);
@@ -6623,17 +6993,362 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
   }
   /* first =  a list of (cons semi-expanded-expression kind) */
 
-  /* Bound names will not be re-bound at this point: */
-  if (rec[drec].comp || (rec[drec].depth != -2)) {
-    scheme_seal_module_rename_set(rn_set, STX_SEAL_BOUND);
-  }
-  scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_BOUND);
+  if (!phase) {
+    /* Bound names will not be re-bound at this point: */
+    if (!erec || (erec[derec].depth != -2)) {
+      scheme_seal_module_rename_set(rn_set, STX_SEAL_BOUND);
+    }
+    scheme_seal_module_rename_set(bxs->post_ex_rn_set, STX_SEAL_BOUND);
+
+    /* Check that all bindings used in phase-N expressions (for N >= 1) 
+       were defined by now: */
+    check_formerly_unbound(unbounds, env);
+  }
+
+  /* Pass 2 */
+  SCHEME_EXPAND_OBSERVE_NEXT_GROUP(observer);
+  
+  if (rec[drec].comp) {
+    /* Module and each `begin-for-syntax' group manages its own prefix: */
+    cenv = scheme_new_comp_env(env->genv, env->insp, SCHEME_TOPLEVEL_FRAME);
+  } else
+    cenv = scheme_extend_as_toplevel(env);
+
+  lift_data = scheme_make_vector(3, NULL);
+  SCHEME_VEC_ELS(lift_data)[0] = (Scheme_Object *)cenv;
+  SCHEME_VEC_ELS(lift_data)[1] = self_modidx;
+  SCHEME_VEC_ELS(lift_data)[2] = rn;
+
+  maybe_has_lifts = 0;
+
+  prev_p = NULL;
+  expanded_l = scheme_null;
+  for (p = first; !SCHEME_NULLP(p); ) {
+    Scheme_Object *e, *l, *ll;
+    int kind;
+
+    e = SCHEME_CAR(p);
+    kind = SCHEME_INT_VAL(SCHEME_CDR(e));
+    e = SCHEME_CAR(e);
+    
+    SCHEME_EXPAND_OBSERVE_NEXT(observer);
+
+    if (kind == SAVED_MODFORM_KIND) {
+      expanded_l = scheme_make_pair(SCHEME_CDR(e), expanded_l);
+      SCHEME_CAR(p) = SCHEME_CAR(e);
+      prev_p = p;
+      p = SCHEME_CDR(p);      
+    } else if (kind == PROVIDE_MODFORM_KIND) {
+      /* handle provides in the third pass */
+      if (erec)
+        expanded_l = scheme_make_pair(e, expanded_l);
+      if (rec[drec].comp) {
+        if (!prev_p)
+          first = SCHEME_CDR(p);
+        else
+          SCHEME_CDR(prev_p) = SCHEME_CDR(p);
+      }
+      p = SCHEME_CDR(p);
+    } else if ((kind == EXPR_MODFORM_KIND)
+               || (kind == DEFN_MODFORM_KIND)) {
+      Scheme_Comp_Env *nenv;
+
+      l = (maybe_has_lifts 
+           ? scheme_frame_get_end_statement_lifts(cenv) 
+           : scheme_null);
+      ll = (maybe_has_lifts 
+            ? scheme_frame_get_provide_lifts(cenv) 
+            : scheme_null);
+      scheme_frame_captures_lifts(cenv, add_lifted_defn, lift_data, l, lift_ctx, req_data, ll);
+      maybe_has_lifts = 1;
+
+      if (kind == DEFN_MODFORM_KIND)
+        nenv = cenv;
+      else
+        nenv = scheme_new_compilation_frame(0, 0, cenv);
+
+      if (erec) {
+	Scheme_Expand_Info erec1;
+	scheme_init_expand_recs(rec, drec, &erec1, 1);
+	erec1.value_name = scheme_false;
+	e = scheme_expand_expr(e, nenv, &erec1, 0);
+        expanded_l = scheme_make_pair(e, expanded_l);        
+      }
+
+      if (rec[drec].comp) {
+	Scheme_Compile_Info crec1;
+	scheme_init_compile_recs(rec, drec, &crec1, 1);
+	crec1.resolve_module_ids = 0;
+	e = scheme_compile_expr(e, nenv, &crec1, 0);
+      }
+
+      lifted_reqs = scheme_append(scheme_frame_get_require_lifts(cenv), lifted_reqs);
+      
+      l = scheme_frame_get_lifts(cenv);
+      if (SCHEME_NULLP(l)) {
+	/* No lifts - continue normally */
+	SCHEME_CAR(p) = e;
+	prev_p = p;
+	p = SCHEME_CDR(p);
+      } else {
+	/* Lifts - insert them and try again */
+        *bxs->all_simple_renames = 0;
+        SCHEME_EXPAND_OBSERVE_MODULE_LIFT_LOOP(observer, scheme_copy_list(l));
+        if (erec) {
+          e = scheme_make_pair(scheme_make_pair(e, SCHEME_CAR(expanded_l)),
+                               scheme_make_integer(4)); /* kept both expanded & maybe compiled */
+          /* add back expanded at correct position later: */
+          expanded_l = SCHEME_CDR(expanded_l);
+        } else
+          e = scheme_make_pair(e, scheme_make_integer(0)); /* don't re-compile/-expand */
+	SCHEME_CAR(p) = e;
+	for (ll = l; SCHEME_PAIRP(ll); ll = SCHEME_CDR(ll)) {
+	  e = scheme_make_pair(SCHEME_CAR(ll), scheme_make_integer(2));
+	  SCHEME_CAR(ll) = e;
+	}
+	p = scheme_append(l, p);
+	if (prev_p) {
+	  SCHEME_CDR(prev_p) = p;
+	} else {
+	  first = p;
+	}
+      }
+    } else {
+      if (erec)
+        expanded_l = scheme_make_pair(e, expanded_l);
+      SCHEME_CAR(p) = e;
+      prev_p = p;
+      p = SCHEME_CDR(p);
+    }
+
+    /* If we're out of declarations, check for lifted-to-end: */
+    if (SCHEME_NULLP(p) && maybe_has_lifts) {
+      int expr_cnt;
+      Scheme_Object *sp;
+      e = scheme_frame_get_provide_lifts(cenv);
+      e = scheme_reverse(e);
+      p = scheme_frame_get_end_statement_lifts(cenv);
+      p = scheme_reverse(p);
+      expr_cnt = scheme_list_length(p);
+      if (!SCHEME_NULLP(e))
+        p = scheme_append(p, e);
+      SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer, p);
+      for (ll = p; SCHEME_PAIRP(ll); ll = SCHEME_CDR(ll)) {
+        e = SCHEME_CAR(ll);
+        if (expr_cnt <= 0) {
+          sp = scheme_make_pair(scheme_make_pair(e, scheme_make_integer(phase)),
+                                bxs->saved_provides);
+          bxs->saved_provides = sp;
+        }
+        e = scheme_make_pair(e, ((expr_cnt > 0) 
+                                 ? scheme_make_integer(EXPR_MODFORM_KIND) 
+                                 : scheme_make_integer(PROVIDE_MODFORM_KIND)));
+        SCHEME_CAR(ll) = e;
+        expr_cnt--;
+      }
+      maybe_has_lifts = 0;
+      if (prev_p) {
+        SCHEME_CDR(prev_p) = p;
+      } else {
+        first = p;
+      }
+    }
+  }
+  if (erec) expanded_l = scheme_reverse(expanded_l);
+
+  adt = scheme_hash_tree_set(bxs->all_defs, scheme_make_integer(phase), all_rt_defs);
+  bxs->all_defs = adt;
+  
+  /* Pass 3 */
+  /* if at phase 0, expand provides for all phases */
+  if (phase == 0) {
+    Scheme_Object *expanded_provides;
+
+    expanded_provides = expand_all_provides(form, cenv, rec, drec, self_modidx,
+                                            bxs, !!erec);
+  
+    if (erec) {
+      expanded_provides = scheme_reverse(expanded_provides);
+      (void)fixup_expanded_provides(expanded_l, expanded_provides, 0);
+    }
+  }
+
+  /* first = a list of compiled expressions */
+  /* expanded_l = reversed list of expanded expressions */
+
+  /* If compiling, drop expressions that are constants: */
+  if (rec[drec].comp) {
+    Scheme_Object *prev = NULL, *next;
+    for (p = first; !SCHEME_NULLP(p); p = next) {
+      next = SCHEME_CDR(p);
+      if (scheme_omittable_expr(SCHEME_CAR(p), -1, -1, 0, NULL, -1)) {
+	if (prev)
+	  SCHEME_CDR(prev) = next;
+	else
+	  first = next;
+      } else
+	prev = p;
+    }
+  }
+
+  if (phase == 0) {
+    if (rec[drec].comp || (rec[drec].depth != -2)) {
+      scheme_seal_module_rename_set(rn_set, STX_SEAL_ALL);
+    }
+    scheme_seal_module_rename_set(bxs->post_ex_rn_set, STX_SEAL_ALL);
+  }
+
+  adt = scheme_hash_tree_set(bxs->all_defs, scheme_make_integer(phase), all_rt_defs);
+  bxs->all_defs = adt;
+
+  if (!phase)
+    env->genv->module->comp_prefix = cenv->prefix;
+  else
+    env->prefix = cenv->prefix;
+
+  if (!SCHEME_NULLP(exp_body)) {
+    if (*bxs->_num_phases < phase + 2)
+      *bxs->_num_phases = phase + 2;
+  }
+
+  if (erec) {
+    /* Add lifted requires */
+    if (!SCHEME_NULLP(lifted_reqs)) {
+      lifted_reqs = scheme_reverse(lifted_reqs);
+      expanded_l = scheme_append(lifted_reqs, expanded_l);
+    }
+  }
+
+  if (rec[drec].comp) {
+    body_lists = scheme_make_pair(first, scheme_make_pair(exp_body, body_lists));
+    if (erec)
+      return scheme_make_pair(expanded_l, body_lists);
+    else
+      return body_lists;
+  } else
+    return expanded_l;
+}
+
+static Scheme_Object *expand_all_provides(Scheme_Object *form,
+                                          Scheme_Comp_Env *cenv, 
+                                          Scheme_Compile_Expand_Info *rec, int drec,
+                                          Scheme_Object *self_modidx,
+                                          Module_Begin_Expand_State *bxs,
+                                          int keep_expanded)
+/* expands `#%provide's for all phases in a module that is otherwise
+   fully expanded; returns a list of expanded forms in reverse order,
+   if requested by `keep_expanded'. */
+{
+  Scheme_Object *saved_provides;
+  Scheme_Object *observer, *expanded_provides = scheme_null;
+  int provide_phase;
+  Scheme_Object *e, *ex, *p_begin_stx, *fst;
+  Scheme_Comp_Env *pcenv;
+
+  observer = rec[drec].observer;
+  
+  saved_provides = scheme_reverse(bxs->saved_provides);
+  while (!SCHEME_NULLP(saved_provides)) {
+    e = SCHEME_CAR(saved_provides);
+    provide_phase = SCHEME_INT_VAL(SCHEME_CDR(e));
+    e = SCHEME_CAR(e);
+    
+    fst = SCHEME_STX_CAR(e);
+    
+    /* Expand and add provides to table: */
+    
+    SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e);
+    SCHEME_EXPAND_OBSERVE_PRIM_PROVIDE(observer);
+      
+    ex = e;
+
+    if (provide_phase != 0) {
+      Scheme_Env *penv = cenv->genv;
+      int k;
+      for (k = 0; k < provide_phase; k++) {
+        penv = penv->exp_env;
+      }
+      if (rec[drec].comp)
+        pcenv = scheme_new_comp_env(penv, penv->insp, SCHEME_TOPLEVEL_FRAME);
+      else
+        pcenv = scheme_new_expand_env(penv, penv->insp, SCHEME_TOPLEVEL_FRAME);
+      p_begin_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin"), 
+                                           scheme_false, 
+                                           scheme_sys_wraps_phase_worker(provide_phase), 
+                                           0, 0);
+    } else {
+      pcenv = cenv;
+      p_begin_stx = scheme_begin_stx;
+    }
+
+    parse_provides(form, fst, e, provide_phase,
+                   bxs->all_provided, bxs->all_reprovided,
+                   self_modidx,
+                   bxs->all_defs_out,
+                   bxs->tables,
+                   bxs->all_defs, 
+                   pcenv, rec, drec,
+                   &ex,
+                   p_begin_stx);
+    
+    if (keep_expanded)
+      expanded_provides = scheme_make_pair(ex, expanded_provides);
+    
+    SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
+    
+    saved_provides = SCHEME_CDR(saved_provides);
+  }
+
+  return expanded_provides;
+}
+
+static Scheme_Object *fixup_expanded_provides(Scheme_Object *expanded_l,
+                                              Scheme_Object *expanded_provides,
+                                              int phase)
+/* mutates `expanded_l' to find `#%provide's (possibly nested in
+   `begin-for-syntax') and elace them with the ones in
+   `expanded_provides'. The provides in `expanded_l' and
+   `expanded_provides' are matched up by order. */
+{
+  Scheme_Object *p, *e, *fst, *prov_stx, *begin_for_syntax_stx, *l;
+
+  if (phase == 0) {
+    prov_stx = provide_stx;
+    begin_for_syntax_stx = scheme_begin_for_syntax_stx;
+  } else {
+    e = scheme_sys_wraps_phase_worker(phase);
+    begin_for_syntax_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin-for-syntax"), scheme_false, e, 0, 0);
+    prov_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%provide"), scheme_false, e, 0, 0);
+  }
+
+  for (p = expanded_l; !SCHEME_NULLP(p); p = SCHEME_CDR(p)) {
+    e = SCHEME_CAR(p);
+    if (SCHEME_STX_PAIRP(e)) {
+      fst = SCHEME_STX_CAR(e);
+      if (scheme_stx_module_eq(prov_stx, fst, 0)) {
+        SCHEME_CAR(p) = SCHEME_CAR(expanded_provides);
+        expanded_provides = SCHEME_CDR(expanded_provides);
+      } else if (scheme_stx_module_eq(begin_for_syntax_stx, fst, 0)) {
+        l = scheme_flatten_syntax_list(e, NULL);
+        expanded_provides = fixup_expanded_provides(SCHEME_CDR(l), expanded_provides, phase + 1);
+        e = scheme_datum_to_syntax(l, e, e, 0, 2);
+        SCHEME_CAR(p) = e;
+      }
+    }
+  }
+
+  return expanded_provides;
+}
+
+static void check_formerly_unbound(Scheme_Object *unbounds,
+                                   Scheme_Comp_Env *env)
+{
+  Scheme_Object *stack = scheme_null, *lst, *p;
+  Scheme_Env *uenv = env->genv->exp_env;
 
-  /* Check that all bindings used in phase-N expressions (for N >= 1) 
-     were defined by now: */
   while (!SCHEME_NULLP(unbounds)) {
-    Scheme_Object *stack = scheme_null, *lst;
-    Scheme_Env *uenv = env->genv->exp_env;
+    stack = scheme_null;
+    uenv = env->genv->exp_env;
 
     lst = SCHEME_CAR(unbounds);
     while(1) {
@@ -6664,337 +7379,82 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
     }
     unbounds = SCHEME_CDR(unbounds);
   }
+
   /* Disallow unbound variables from now on: */
-  {
-    Scheme_Env *uenv = env->genv->exp_env;
-    while (uenv) {
-      uenv->disallow_unbound = 1;
-      uenv = uenv->exp_env;
-    }
+  uenv = env->genv->exp_env;
+  while (uenv) {
+    uenv->disallow_unbound = 1;
+    uenv = uenv->exp_env;
   }
+}
 
-  /* Pass 2 */
-  SCHEME_EXPAND_OBSERVE_NEXT_GROUP(observer);
-  
-  if (rec[drec].comp) {
-    /* Module manages its own prefix. That's how we get
-       multiple instantiation of a module with "dynamic linking". */
-    cenv = scheme_new_comp_env(env->genv, env->insp, SCHEME_TOPLEVEL_FRAME);
-  } else
-    cenv = scheme_extend_as_toplevel(env);
+static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv)
+{
+  Scheme_Object *stop, *w, *s;
 
-  lift_data = scheme_make_vector(3, NULL);
-  SCHEME_VEC_ELS(lift_data)[0] = (Scheme_Object *)cenv;
-  SCHEME_VEC_ELS(lift_data)[1] = self_modidx;
-  SCHEME_VEC_ELS(lift_data)[2] = rn;
+  stop = scheme_get_stop_expander();
 
-  maybe_has_lifts = 0;
+  scheme_add_local_syntax(19, xenv);
 
-  prev_p = NULL;
-  for (p = first; !SCHEME_NULLP(p); ) {
-    Scheme_Object *e, *l, *ll;
-    int kind;
-
-    e = SCHEME_CAR(p);
-    kind = SCHEME_INT_VAL(SCHEME_CDR(e));
-    e = SCHEME_CAR(e);
-    
-    SCHEME_EXPAND_OBSERVE_NEXT(observer);
-
-    if (kind == 3) {
-      Scheme_Object *fst;
-
-      fst = SCHEME_STX_CAR(e);
-
-      if (scheme_stx_module_eq(provide_stx, fst, 0)) {
-        /************ provide *************/
-        /* Add provides to table: */
-        Scheme_Object *ex;
-
-        SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e);
-        SCHEME_EXPAND_OBSERVE_PRIM_PROVIDE(observer);
-      
-        ex = e;
-  
-        parse_provides(form, fst, e, 
-                       all_provided, all_reprovided,
-                       self_modidx,
-                       &all_defs_out, &all_et_defs_out,
-                       tables,
-                       all_defs, all_et_defs, cenv, rec, drec,
-                       &ex);
-        
-        e = ex;
-
-        SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
-      }
-      if (!rec[drec].comp) {
-        SCHEME_CAR(p) = e;
-        prev_p = p;
-        p = SCHEME_CDR(p);
-      } else {
-        p = SCHEME_CDR(p);
-        if (!prev_p)
-          first = p;
-        else
-          SCHEME_CDR(prev_p) = p;
-      }
-    } else if (kind) {
-      Scheme_Comp_Env *nenv;
-
-      l = (maybe_has_lifts 
-           ? scheme_frame_get_end_statement_lifts(cenv) 
-           : scheme_null);
-      ll = (maybe_has_lifts 
-            ? scheme_frame_get_provide_lifts(cenv) 
-            : scheme_null);
-      scheme_frame_captures_lifts(cenv, add_lifted_defn, lift_data, l, lift_ctx, req_data, ll);
-      maybe_has_lifts = 1;
-
-      if (kind == 2)
-        nenv = cenv;
-      else
-        nenv = scheme_new_compilation_frame(0, 0, cenv);
-
-      if (rec[drec].comp) {
-	Scheme_Compile_Info crec1;
-	scheme_init_compile_recs(rec, drec, &crec1, 1);
-	crec1.resolve_module_ids = 0;
-	e = scheme_compile_expr(e, nenv, &crec1, 0);
-      } else {
-	Scheme_Expand_Info erec1;
-	scheme_init_expand_recs(rec, drec, &erec1, 1);
-	erec1.value_name = scheme_false;
-	e = scheme_expand_expr(e, nenv, &erec1, 0);
-      }
-
-      lifted_reqs = scheme_append(scheme_frame_get_require_lifts(cenv), lifted_reqs);
-      
-      l = scheme_frame_get_lifts(cenv);
-      if (SCHEME_NULLP(l)) {
-	/* No lifts - continue normally */
-	SCHEME_CAR(p) = e;
-	prev_p = p;
-	p = SCHEME_CDR(p);
-      } else {
-	/* Lifts - insert them and try again */
-        *all_simple_renames = 0;
-        SCHEME_EXPAND_OBSERVE_MODULE_LIFT_LOOP(observer, scheme_copy_list(l));
-	e = scheme_make_pair(e, scheme_make_integer(0)); /* don't re-compile/-expand */
-	SCHEME_CAR(p) = e;
-	for (ll = l; SCHEME_PAIRP(ll); ll = SCHEME_CDR(ll)) {
-	  e = scheme_make_pair(SCHEME_CAR(ll), scheme_make_integer(2));
-	  SCHEME_CAR(ll) = e;
-	}
-	p = scheme_append(l, p);
-	if (prev_p) {
-	  SCHEME_CDR(prev_p) = p;
-	} else {
-	  first = p;
-	}
-      }
-    } else {
-      SCHEME_CAR(p) = e;
-      prev_p = p;
-      p = SCHEME_CDR(p);
-    }
-
-    /* If we're out of declarations, check for lifted-to-end: */
-    if (SCHEME_NULLP(p) && maybe_has_lifts) {
-      int expr_cnt;
-      e = scheme_frame_get_provide_lifts(cenv);
-      e = scheme_reverse(e);
-      p = scheme_frame_get_end_statement_lifts(cenv);
-      p = scheme_reverse(p);
-      expr_cnt = scheme_list_length(p);
-      if (!SCHEME_NULLP(e))
-        p = scheme_append(p, e);
-      SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer, p);
-      for (ll = p; SCHEME_PAIRP(ll); ll = SCHEME_CDR(ll)) {
-        e = scheme_make_pair(SCHEME_CAR(ll), (expr_cnt > 0) ? scheme_make_integer(1) : scheme_make_integer(3));
-        SCHEME_CAR(ll) = e;
-        expr_cnt--;
-      }
-      maybe_has_lifts = 0;
-      if (prev_p) {
-        SCHEME_CDR(prev_p) = p;
-      } else {
-        first = p;
-      }
-    }
-  }
-  /* first = a list of expanded/compiled expressions */
-
-  /* If compiling, drop expressions that are constants: */
-  if (rec[drec].comp) {
-    Scheme_Object *prev = NULL, *next;
-    for (p = first; !SCHEME_NULLP(p); p = next) {
-      next = SCHEME_CDR(p);
-      if (scheme_omittable_expr(SCHEME_CAR(p), -1, -1, 0, NULL, -1)) {
-	if (prev)
-	  SCHEME_CDR(prev) = next;
-	else
-	  first = next;
-      } else
-	prev = p;
-    }
-  }
-
-  if (rec[drec].comp || (rec[drec].depth != -2)) {
-    scheme_seal_module_rename_set(rn_set, STX_SEAL_ALL);
-  }
-  scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_ALL);
-
-  /* Compute provides for re-provides and all-defs-out: */
-  (void)compute_reprovides(all_provided,
-                           all_reprovided, 
-                           env->genv->module, 
-                           tables,
-                           env->genv, 
-                           all_defs, all_defs_out, 
-                           all_et_defs, all_et_defs_out, 
-                           "require", NULL, NULL);
-
-  /* Compute provide arrays */
-  exps = compute_provide_arrays(all_provided, tables,
-                                env->genv->module->me,
-                                env->genv,
-                                form, &et_exps);
-  
-  /* Compute indirect provides (which is everything at the top-level): */
-  exis = compute_indirects(env->genv, env->genv->module->me->rt, &exicount, 1);
-  exsis = compute_indirects(env->genv, env->genv->module->me->rt, &exsicount, 0);
-  et_exis = compute_indirects(env->genv->exp_env, env->genv->module->me->et, &et_exicount, 1);
-
-  if (rec[drec].comp || (rec[drec].depth != -2)) {
-    scheme_clean_dead_env(env->genv);
-  }
-
-  if (!rec[drec].comp) {
-    Scheme_Module_Phase_Exports *rt = env->genv->module->me->rt;
-    int excount = rt->num_provides;
-    int exvcount = rt->num_var_provides;
-    Scheme_Object **exsns = rt->provide_src_names;
-    Scheme_Object **exs = rt->provides;
-    Scheme_Object **exss = rt->provide_srcs;
-
-    /* Produce annotations (in the form of properties)
-       for module information:
-         'module-variable-provides = '(item ...)
-         'module-syntax-provides = '(item ...)
-	 'module-indirect-provides = '(id ...)
-         'module-kernel-reprovide-hint = 'kernel-reexport
-
-      item = name
-           | (ext-id . def-id)
-           | (modidx ext-id . def-id)
-     kernel-reexport = #f
-                     | #t
-                     | exclusion-id
-    */
-    int j;
-    Scheme_Object *e, *a, *result;
-
-    result = scheme_null;
-
-    /* kernel re-export info (always #f): */
-    result = scheme_make_pair(scheme_false, result);
-
-    /* Indirect provides */ 
-    a = scheme_null;
-    for (j = 0; j < exicount; j++) {
-      a = scheme_make_pair(exis[j], a);
-    }
-    result = scheme_make_pair(a, result);
-    
-    /* add syntax and value exports: */
-    for (j = 0; j < 2; j++) {
-      int top, i;
-
-      e = scheme_null;
-
-      if (!j) {
-	i = exvcount;
-	top = excount;
-      } else {
-	i = 0;
-	top = exvcount;
-      }
-      
-      for (; i < top; i++) {
-	if (SCHEME_FALSEP(exss[i])
-	    && SAME_OBJ(exs[i], exsns[i]))
-	  a = exs[i];
-	else {
-	  a = scheme_make_pair(exs[i], exsns[i]);
-	  if (!SCHEME_FALSEP(exss[i])) {
-	    a = scheme_make_pair(exss[i], a);
-	  }
-	}
-	e = scheme_make_pair(a, e);
-      }
-      result = scheme_make_pair(e, result);
-    }
-
-    env->genv->module->hints = result;
-  }
-
-  if (rec[drec].comp) {
-    Scheme_Object *exp_body_r = scheme_null;
-    
-    /* Reverse exp_body */
-    while (!SCHEME_NULLP(exp_body)) {
-      exp_body_r = scheme_make_pair(SCHEME_CAR(exp_body),
-				    exp_body_r);
-      exp_body = SCHEME_CDR(exp_body);
-    }
-
-    first = scheme_list_to_vector(first);
-    env->genv->module->body = first;
-    exp_body_r = scheme_list_to_vector(exp_body_r);
-    env->genv->module->et_body = exp_body_r;
-
-    env->genv->module->provide_protects = exps;
-    env->genv->module->et_provide_protects = et_exps;
-
-    env->genv->module->indirect_provides = exis;
-    env->genv->module->num_indirect_provides = exicount;
-
-    if (*all_simple_renames) {
-      env->genv->module->indirect_syntax_provides = exsis;
-      env->genv->module->num_indirect_syntax_provides = exsicount;
-    } else {
-      env->genv->module->indirect_syntax_provides = NULL;
-      env->genv->module->num_indirect_syntax_provides = 0;
-    }
-
-    env->genv->module->et_indirect_provides = et_exis;
-    env->genv->module->num_indirect_et_provides = et_exicount;
-
-    env->genv->module->comp_prefix = cenv->prefix;
-
-    if (*all_simple_renames) {
-      env->genv->module->rn_stx = scheme_true;
-    }
-
-    return (Scheme_Object *)env->genv->module;
+  if (phase == 0) {
+    scheme_set_local_syntax(0, scheme_begin_stx, stop, xenv);
+    scheme_set_local_syntax(1, scheme_define_values_stx, stop, xenv);
+    scheme_set_local_syntax(2, scheme_define_syntaxes_stx, stop, xenv);
+    scheme_set_local_syntax(3, scheme_begin_for_syntax_stx, stop, xenv);
+    scheme_set_local_syntax(4, require_stx, stop, xenv);
+    scheme_set_local_syntax(5, provide_stx, stop, xenv);
+    scheme_set_local_syntax(6, set_stx, stop, xenv);
+    scheme_set_local_syntax(7, app_stx, stop, xenv);
+    scheme_set_local_syntax(8, scheme_top_stx, stop, xenv);
+    scheme_set_local_syntax(9, lambda_stx, stop, xenv);
+    scheme_set_local_syntax(10, case_lambda_stx, stop, xenv);
+    scheme_set_local_syntax(11, let_values_stx, stop, xenv);
+    scheme_set_local_syntax(12, letrec_values_stx, stop, xenv);
+    scheme_set_local_syntax(13, if_stx, stop, xenv);
+    scheme_set_local_syntax(14, begin0_stx, stop, xenv);
+    scheme_set_local_syntax(15, with_continuation_mark_stx, stop, xenv);
+    scheme_set_local_syntax(16, letrec_syntaxes_stx, stop, xenv);
+    scheme_set_local_syntax(17, var_ref_stx, stop, xenv);
+    scheme_set_local_syntax(18, expression_stx, stop, xenv);
+    sv[0] = scheme_define_values_stx;
+    sv[1] = scheme_begin_stx;
+    sv[2] = scheme_define_syntaxes_stx;
+    sv[3] = scheme_begin_for_syntax_stx;
+    sv[4] = require_stx;
+    sv[5] = provide_stx;
   } else {
-    if (rec[drec].depth == -2) {
-      /* This was a local expand. Flush definitions, because the body expand may start over. */
-      flush_definitions(env->genv);
-      if (env->genv->exp_env)
-        flush_definitions(env->genv->exp_env);
-    }
-
-    p = SCHEME_STX_CAR(form);
-
-    /* Add lifted requires */
-    if (!SCHEME_NULLP(lifted_reqs)) {
-      lifted_reqs = scheme_reverse(lifted_reqs);
-      first = scheme_append(lifted_reqs, first);
-    }
-
-    return scheme_datum_to_syntax(cons(p, first), orig_form, orig_form, 0, 2);
+    w = scheme_sys_wraps_phase_worker(phase);
+    s = scheme_datum_to_syntax(scheme_intern_symbol("begin"), scheme_false, w, 0, 0);
+    sv[1] = s;
+    scheme_set_local_syntax(0, s, stop, xenv);
+    s = scheme_datum_to_syntax(scheme_intern_symbol("define-values"), scheme_false, w, 0, 0);
+    sv[0] = s;
+    scheme_set_local_syntax(1, s, stop, xenv);
+    s = scheme_datum_to_syntax(scheme_intern_symbol("define-syntaxes"), scheme_false, w, 0, 0);
+    sv[2] = s;
+    scheme_set_local_syntax(2, s, stop, xenv);
+    s = scheme_datum_to_syntax(scheme_intern_symbol("begin-for-syntax"), scheme_false, w, 0, 0);
+    sv[3] = s;
+    scheme_set_local_syntax(3, s, stop, xenv);
+    s = scheme_datum_to_syntax(scheme_intern_symbol("#%require"), scheme_false, w, 0, 0);
+    sv[4] = s;
+    scheme_set_local_syntax(4, s, stop, xenv);
+    s = scheme_datum_to_syntax(scheme_intern_symbol("#%provide"), scheme_false, w, 0, 0);
+    sv[5] = s;
+    scheme_set_local_syntax(5, s, stop, xenv);
+    scheme_set_local_syntax(6, scheme_datum_to_syntax(scheme_intern_symbol("set!"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(7, scheme_datum_to_syntax(scheme_intern_symbol("#%app"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(8, scheme_datum_to_syntax(scheme_intern_symbol("#%top"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(9, scheme_datum_to_syntax(scheme_intern_symbol("lambda"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(10, scheme_datum_to_syntax(scheme_intern_symbol("case-lambda"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(11, scheme_datum_to_syntax(scheme_intern_symbol("let-values"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(12, scheme_datum_to_syntax(scheme_intern_symbol("letrec-values"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(13, scheme_datum_to_syntax(scheme_intern_symbol("if"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(14, scheme_datum_to_syntax(scheme_intern_symbol("begin0"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(15, scheme_datum_to_syntax(scheme_intern_symbol("with-continuation-mark"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(16, scheme_datum_to_syntax(scheme_intern_symbol("letrec-syntaxes+values"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(17, scheme_datum_to_syntax(scheme_intern_symbol("#%variable-reference"), scheme_false, w, 0, 0), stop, xenv);
+    scheme_set_local_syntax(18, scheme_datum_to_syntax(scheme_intern_symbol("#%expression"), scheme_false, w, 0, 0), stop, xenv);
   }
 }
 
@@ -7033,8 +7493,8 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
                        Scheme_Module *mod_for_requires,
                        Scheme_Hash_Table *tables,
                        Scheme_Env *_genv, 
-                       Scheme_Object *all_rt_defs, Scheme_Object *all_rt_defs_out, 
-                       Scheme_Object *all_et_defs, Scheme_Object *all_et_defs_out, 
+                       int num_phases,
+                       Scheme_Hash_Tree *all_defs, Scheme_Hash_Table *all_defs_out, 
                        const char *matching_form,
                        Scheme_Object *all_mods, /* a phase list to use for all mods */
                        Scheme_Object *all_phases) /* a module-path list for all phases */
@@ -7043,7 +7503,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
   Scheme_Object *reprovided, *tvec;
   int i, k, z;
   Scheme_Object *rx, *provided_list, *phase, *req_phase;
-  Scheme_Object *all_defs, *all_defs_out;
+  Scheme_Object *all_x_defs, *all_x_defs_out;
   Scheme_Env *genv;
 
   if (all_phases) {
@@ -7289,27 +7749,20 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
   }
 
   /* Do all-defined provides */
-  for (z = 0; z < 2; z++) {
-    if (!z) {
-      all_defs = all_rt_defs;
-      all_defs_out = all_rt_defs_out;
-      provided = (Scheme_Hash_Table *)scheme_hash_get(all_provided, scheme_make_integer(0));
-      phase = scheme_make_integer(0);
-      genv = _genv;
-    } else {
-      all_defs = all_et_defs;
-      all_defs_out = all_et_defs_out;
-      provided = (Scheme_Hash_Table *)scheme_hash_get(all_provided, scheme_make_integer(1));
-      phase = scheme_make_integer(1);
-      genv = _genv->exp_env;
-    }
-
-    if (all_defs_out) {
-      for (; !SCHEME_NULLP(all_defs_out); all_defs_out = SCHEME_CDR(all_defs_out)) {
+  genv = _genv;
+  for (z = 0; z < num_phases; z++) {
+    all_x_defs = scheme_hash_tree_get(all_defs, scheme_make_integer(z));
+    if (!all_x_defs) all_x_defs = scheme_null;
+    all_x_defs_out = scheme_hash_get(all_defs_out, scheme_make_integer(z));
+    provided = (Scheme_Hash_Table *)scheme_hash_get(all_provided, scheme_make_integer(z));
+    phase = scheme_make_integer(z);
+    
+    if (all_x_defs_out) {
+      for (; !SCHEME_NULLP(all_x_defs_out); all_x_defs_out = SCHEME_CDR(all_x_defs_out)) {
         Scheme_Object *exns, *ree, *ree_kw, *exl, *name, *a, *adl, *exname, *pfx;
         int protected;
 	    
-        ree = SCHEME_CAR(all_defs_out);
+        ree = SCHEME_CAR(all_x_defs_out);
         protected = SCHEME_TRUEP(SCHEME_CDR(ree));
         ree = SCHEME_CAR(ree);
         ree_kw = SCHEME_CAR(ree);
@@ -7327,7 +7780,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
           }
         }
 
-        for (adl = all_defs; SCHEME_PAIRP(adl); adl = SCHEME_CDR(adl)) {
+        for (adl = all_x_defs; SCHEME_PAIRP(adl); adl = SCHEME_CDR(adl)) {
           name = SCHEME_CAR(adl);
           exname = SCHEME_STX_SYM(name);
           name = scheme_tl_id_sym(genv, name, NULL, 0, NULL, NULL);
@@ -7368,6 +7821,8 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
         }
       }
     }
+
+    genv = _genv->exp_env;
   }
 
   return 1;
@@ -7489,7 +7944,8 @@ Scheme_Object *scheme_module_imported_list(Scheme_Env *genv, Scheme_Object *bind
                          genv->module, 
                          tables,
                          genv, 
-                         NULL, NULL, NULL, NULL, 
+                         0,
+                         NULL, NULL,
                          NULL,
                          all_mods, all_phases);
     
@@ -7621,16 +8077,33 @@ static Scheme_Object *extract_free_id_name(Scheme_Object *name,
   return name;
 }
 
-char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *tables,
-                             Scheme_Module_Exports *me,
-                             Scheme_Env *genv,
-                             Scheme_Object *form,
-                             char **_phase1_protects)
+static int lookup(Scheme_Env *genv, Scheme_Object *phase, int as_syntax, const char *name)
+{
+  int p;
+
+  if (SCHEME_FALSEP(phase))
+    return 0;
+
+  p = SCHEME_INT_VAL(phase);
+  while (p--) {
+    genv = genv->exp_env;
+    if (!genv) return 0;
+  }
+  
+  return !!scheme_lookup_in_table((as_syntax ? genv->syntax : genv->toplevel), (const char *)name);
+}
+
+void compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *tables,
+                            Scheme_Module_Exports *me,
+                            Scheme_Env *genv,
+                            Scheme_Object *form,
+                            int num_phases, Scheme_Module_Export_Info **exp_infos)
 {
   int i, count, z, implicit;
   Scheme_Object **exs, **exsns, **exss, **exsnoms, *phase;
   Scheme_Hash_Table *provided, *required;
-  char *exps, *exets, *phase0_exps = NULL, *phase1_exps = NULL;
+  char *exps;
+  int *exets;
   int excount, exvcount;
   Scheme_Module_Phase_Exports *pt;
   Scheme_Object *implicit_src, *implicit_src_name, *implicit_mod_phase;
@@ -7673,8 +8146,8 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
       exss = MALLOC_N(Scheme_Object *, count);
       exsnoms = MALLOC_N(Scheme_Object *, count);
       exps = MALLOC_N_ATOMIC(char, count);
-      exets = MALLOC_N_ATOMIC(char, count);
-      memset(exets, 0, count);
+      exets = MALLOC_N_ATOMIC(int, count);
+      memset(exets, 0, count * sizeof(int));
 
       /* Do non-syntax first. */
       for (count = 0, i = provided->size; i--; ) {
@@ -7693,25 +8166,18 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
 
           if (!implicit
               && genv 
-              && (SAME_OBJ(phase, scheme_make_integer(0))
-                  || SAME_OBJ(phase, scheme_make_integer(1)))
-              && scheme_lookup_in_table(SAME_OBJ(phase, scheme_make_integer(0))
-                                        ? genv->toplevel
-                                        : genv->exp_env->toplevel,
-                                        (const char *)name)) {
+              && lookup(genv, phase, 0, (const char *)name)) {
             /* Defined locally */
             exs[count] = provided->keys[i];
             exsns[count] = name;
             exss[count] = scheme_false; /* means "self" */
             exsnoms[count] = scheme_null; /* since "self" */
             exps[count] = protected;
-            if (SAME_OBJ(phase, scheme_make_integer(1)))
-              exets[count] = 1;
+            exets[count] = SCHEME_INT_VAL(phase);
             count++;
           } else if (!implicit
                      && genv 
-                     && SAME_OBJ(phase, scheme_make_integer(0))
-                     && scheme_lookup_in_table(genv->syntax, (const char *)name)) {
+                     && lookup(genv, phase, 1, (const char *)name)) {
             /* Skip syntax for now. */
           } else if (implicit) {
             /* Rename-transformer redirect; skip for now. */
@@ -7729,14 +8195,21 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
               noms = adjust_for_rename(exs[count], SCHEME_VEC_ELS(v)[4], SCHEME_VEC_ELS(v)[0]);
               exsnoms[count] = noms;
               exps[count] = protected;
-              if (SAME_OBJ(SCHEME_VEC_ELS(v)[8], scheme_make_integer(1)))
-                exets[count] = 1;
+              exets[count] = SCHEME_INT_VAL(SCHEME_VEC_ELS(v)[8]);
 
               count++;
             }
           } else {
             /* Not defined! */
-            scheme_wrong_syntax("module", prnt_name, form, "provided identifier not defined or imported");
+            char buf[32], *phase_expl;
+            if (phase) {
+              sprintf(buf, " for phase %" PRIxPTR, SCHEME_INT_VAL(phase));
+              phase_expl = scheme_strdup(buf);
+            } else
+              phase_expl = "";
+            scheme_wrong_syntax("module", prnt_name, form, 
+                                "provided identifier not defined or imported%s",
+                                phase_expl);
           }
         }
       }
@@ -7759,14 +8232,14 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
 
           if (!implicit
               && genv 
-              && SAME_OBJ(phase, scheme_make_integer(0))
-              && scheme_lookup_in_table(genv->syntax, (const char *)name)) {
+              && lookup(genv, phase, 1, (const char *)name)) {
             /* Defined locally */
             exs[count] = provided->keys[i];
             exsns[count] = name;
             exss[count] = scheme_false; /* means "self" */
             exsnoms[count] = scheme_null; /* since "self" */
             exps[count] = protected;
+            exets[count] = SCHEME_INT_VAL(phase);
             count++;
           } else if (implicit) {
             /* We record all free-id=?-based exports as syntax, even though they may be values. */
@@ -7828,27 +8301,38 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
       pt->provide_nominal_srcs = exsnoms;
       pt->provide_src_phases = exets;
 
-      if (SAME_OBJ(phase, scheme_make_integer(0)))
-        phase0_exps = exps;
-      else if (SAME_OBJ(phase, scheme_make_integer(1)))
-        phase1_exps = exps;
+      /* Discard exps if all 0 */
+      if (exps) {
+        for (i = 0; i < excount; i++) {
+          if (exps[i])
+            break;
+        }
+        if (i >= excount)
+          exps = NULL;
+      }
+
+      if (exps) {
+        if (SCHEME_TRUEP(phase)) {
+          if ((SCHEME_INT_VAL(phase) < 0)
+              || (SCHEME_INT_VAL(phase) >= num_phases))
+            scheme_signal_error("internal error: bad phase for exports");
+          exp_infos[SCHEME_INT_VAL(phase)]->provide_protects = exps;
+        }
+      }
     }
   }
-
-  *_phase1_protects = phase1_exps;
-    
-  return phase0_exps;
 }
 
 /* Helper: */
 static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Object **exss, 
-                           char *exps, char *exets,
+                           char *exps, int *exets,
 			   Scheme_Object **exsnoms,
                            int start, int count, int do_uninterned)
 {
   int i, j;
   Scheme_Object *tmp_ex, *tmp_exsn, *tmp_exs, *tmp_exsnom, *pivot;
-  char tmp_exp, tmp_exet;
+  char tmp_exp;
+  int tmp_exet;
 
   if (do_uninterned) {
     /* Look for uninterned and move to end: */
@@ -7961,9 +8445,9 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob
   }
 }
 
-static Scheme_Object *expand_provide(Scheme_Object *e, 
+static Scheme_Object *expand_provide(Scheme_Object *e, int at_phase,
                                      Scheme_Hash_Table *tables,
-                                     Scheme_Object *all_defs, Scheme_Object *all_et_defs,
+                                     Scheme_Hash_Tree *all_defs,
                                      Scheme_Comp_Env *cenv, Scheme_Compile_Info *rec, int drec)
 {
   Scheme_Expand_Info erec1;
@@ -7975,10 +8459,16 @@ static Scheme_Object *expand_provide(Scheme_Object *e,
 				      cenv);
   stop = scheme_get_stop_expander();
   scheme_add_local_syntax(1, xenv);
-  scheme_set_local_syntax(0, scheme_begin_stx, stop, xenv);
+  if (!at_phase)
+    scheme_set_local_syntax(0, scheme_begin_stx, stop, xenv);
+  else
+    scheme_set_local_syntax(0, scheme_datum_to_syntax(scheme_intern_symbol("begin"), 
+                                                      scheme_false, 
+                                                      scheme_sys_wraps_phase_worker(at_phase), 
+                                                      0, 0), 
+                            stop, xenv);
 
-  b = scheme_make_pair((Scheme_Object *)tables,
-                       scheme_make_pair(all_defs, all_et_defs));
+  b = scheme_make_pair((Scheme_Object *)tables, (Scheme_Object *)all_defs);
   scheme_current_thread->current_local_bindings = b;
   
   scheme_init_expand_recs(rec, drec, &erec1, 1);
@@ -7993,20 +8483,21 @@ static Scheme_Object *expand_provide(Scheme_Object *e,
 }
 
 void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, 
+                    int at_phase,
                     Scheme_Hash_Table *all_provided,
                     Scheme_Hash_Table *all_reprovided,
                     Scheme_Object *self_modidx, 
-                    Scheme_Object **_all_defs_out,
-                    Scheme_Object **_et_all_defs_out,
+                    Scheme_Hash_Table *all_defs_out,
                     Scheme_Hash_Table *tables,
-                    Scheme_Object *all_defs, Scheme_Object *all_et_defs,
+                    Scheme_Hash_Tree *all_defs,
                     Scheme_Comp_Env *cenv, Scheme_Compile_Info *rec, int drec,
-                    Scheme_Object **_expanded)
+                    Scheme_Object **_expanded,
+                    Scheme_Object *begin_stx)
 {
   Scheme_Object *l, *rebuilt = scheme_null, *protect_stx = NULL;
   int protect_cnt = 0, mode_cnt = 0, expanded = 0;
   Scheme_Object *mode = scheme_make_integer(0), *mode_stx = NULL;
-  Scheme_Object *all_defs_out;
+  Scheme_Object *all_x_defs_out, *all_x_defs;
   Scheme_Hash_Table *provided;
   Scheme_Object *phase;
 
@@ -8085,19 +8576,19 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
         break;
     }
 
-    if (SAME_OBJ(mode, scheme_make_integer(0)))
-      all_defs_out = *_all_defs_out;
-    else if (SAME_OBJ(mode, scheme_make_integer(1)))
-      all_defs_out = *_et_all_defs_out;
+    if (SCHEME_FALSEP(mode))
+      phase = mode;
     else
-      all_defs_out = NULL;
+      phase = scheme_bin_plus(mode, scheme_make_integer(at_phase));
 
-    provided = (Scheme_Hash_Table *)scheme_hash_get(all_provided, mode);
+    all_x_defs_out = scheme_hash_get(all_defs_out, phase);
+    if (!all_x_defs_out) all_x_defs_out = scheme_null;
+
+    provided = (Scheme_Hash_Table *)scheme_hash_get(all_provided, phase);
     if (!provided) {
       provided = scheme_make_hash_table(SCHEME_hash_ptr);
-      scheme_hash_set(all_provided, mode, (Scheme_Object *)provided);
+      scheme_hash_set(all_provided, phase, (Scheme_Object *)provided);
     }
-    phase = mode;
 
     if (SCHEME_STX_SYMBOLP(a)) {
       /* <id> */
@@ -8125,7 +8616,9 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
           return;
         }
 
-        p = expand_provide(p, tables, all_defs, all_et_defs, cenv, rec, drec);
+        all_x_defs = scheme_hash_tree_get(all_defs, mode);
+        if (!all_x_defs) all_x_defs = scheme_null;
+        p = expand_provide(p, at_phase, tables, all_defs, cenv, rec, drec);
 
         /* Check for '(begin datum ...) result: */
         p = scheme_flatten_syntax_list(p, &islist);
@@ -8136,7 +8629,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
         else {
           rest = SCHEME_CAR(p);
           if (!SCHEME_STX_SYMBOLP(rest)
-              || !scheme_stx_module_eq(scheme_begin_stx, rest, 0)) {
+              || !scheme_stx_module_eq(begin_stx, rest, at_phase)) {
             p = NULL;
           }
         }
@@ -8298,16 +8791,16 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
         if (!SCHEME_STX_NULLP(rest))
           scheme_wrong_syntax(NULL, a, e, "bad syntax");
         
-        if (!all_defs_out) {
+        if (!all_x_defs_out) {
           scheme_wrong_syntax(NULL, a, e, "no definitions at phase level %V",
                               mode);
         }
 
-        all_defs_out = scheme_make_pair(scheme_make_pair(scheme_make_pair(e, 
-                                                                          scheme_make_pair(scheme_null, 
-                                                                                           scheme_false)),
-                                                         protect_cnt ? scheme_true : scheme_false),
-                                        all_defs_out);
+        all_x_defs_out = scheme_make_pair(scheme_make_pair(scheme_make_pair(e, 
+                                                                            scheme_make_pair(scheme_null, 
+                                                                                             scheme_false)),
+                                                           protect_cnt ? scheme_true : scheme_false),
+                                          all_x_defs_out);
       } else if (SAME_OBJ(prefix_all_defined_symbol, SCHEME_STX_VAL(fst))) {
         /* (prefix-all-defined <prefix>) */
         Scheme_Object *prefix;
@@ -8325,16 +8818,16 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
         }
         prefix = SCHEME_STX_VAL(prefix);
 
-        if (!all_defs_out) {
+        if (!all_x_defs_out) {
           scheme_wrong_syntax(NULL, a, e, "no definitions at phase level %V",
                               mode);
         }
         
-        all_defs_out = scheme_make_pair(scheme_make_pair(scheme_make_pair(e, 
-                                                                          scheme_make_pair(scheme_null, 
-                                                                                           prefix)),
-                                                         protect_cnt ? scheme_true : scheme_false),
-                                        all_defs_out);
+        all_x_defs_out = scheme_make_pair(scheme_make_pair(scheme_make_pair(e, 
+                                                                            scheme_make_pair(scheme_null, 
+                                                                                             prefix)),
+                                                           protect_cnt ? scheme_true : scheme_false),
+                                          all_x_defs_out);
       } else if (SAME_OBJ(all_defined_except_symbol, SCHEME_STX_VAL(fst))
                  || SAME_OBJ(prefix_all_defined_except_symbol, SCHEME_STX_VAL(fst))) {
         /* ([prefix-]all-defined-except <id> ...) */
@@ -8370,16 +8863,16 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
           }
         }
 		
-        if (!all_defs_out) {
+        if (!all_x_defs_out) {
           scheme_wrong_syntax(NULL, a, e, "no definitions at phase level %V",
                               mode);
         }
         
-        all_defs_out = scheme_make_pair(scheme_make_pair(scheme_make_pair(e, 
-                                                                          scheme_make_pair(exns,
-                                                                                           prefix)),
-                                                         protect_cnt ? scheme_true : scheme_false),
-                                        all_defs_out);
+        all_x_defs_out = scheme_make_pair(scheme_make_pair(scheme_make_pair(e, 
+                                                                            scheme_make_pair(exns,
+                                                                                             prefix)),
+                                                           protect_cnt ? scheme_true : scheme_false),
+                                          all_x_defs_out);
       } else {
         scheme_wrong_syntax(NULL, a, e, NULL);
       }
@@ -8409,10 +8902,8 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
     if (protect_cnt)
       --protect_cnt;
 
-    if (SAME_OBJ(mode, scheme_make_integer(0)))
-      *_all_defs_out = all_defs_out;
-    else if (SAME_OBJ(mode, scheme_make_integer(1)))
-      *_et_all_defs_out = all_defs_out;
+    if (all_x_defs_out)
+      scheme_hash_set(all_defs_out, mode, all_x_defs_out);
 
     if (mode_cnt) {
       --mode_cnt;
@@ -8501,7 +8992,7 @@ Scheme_Object *scheme_module_exported_list(Scheme_Object *modpath, Scheme_Env *g
 
 void add_single_require(Scheme_Module_Exports *me, /* from module */
                         Scheme_Object *only_phase,
-                        Scheme_Object *src_phase_index,
+                        Scheme_Object *src_phase_index, /* import from pahse 0 to src_phase_index */
 			Scheme_Object *idx, /* from module's idx; may be saved for unmarshalling */
 			Scheme_Env *orig_env, /* env for mark_src or copy_vars */
 			Scheme_Object *rn_set, /* add requires to renames in this set when no mark_src */
@@ -8524,12 +9015,12 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
   int j, var_count;
   Scheme_Object *orig_idx = idx, *to_phase;
   Scheme_Object **exs, **exsns, **exss, *context_marks = scheme_null;
-  char *exets;
+  int *exets;
   int has_context, save_marshal_info = 0;
   Scheme_Object *nominal_modidx, *one_exn, *prnt_iname, *name, *rn, *ename = orig_ename;
   Scheme_Hash_Table *orig_onlys;
   int k, skip_rename, do_copy_vars;
-  
+
   if (mark_src) {
     /* Check whether there's context for this import (which
        leads to generated local names). */
@@ -8886,7 +9377,7 @@ Scheme_Object *scheme_get_kernel_modidx(void)
   return kernel_modidx;
 }
 
-void parse_requires(Scheme_Object *form, 
+void parse_requires(Scheme_Object *form, int at_phase,
                     Scheme_Object *base_modidx,
                     Scheme_Env *main_env,
                     Scheme_Module *for_m,
@@ -8961,9 +9452,12 @@ void parse_requires(Scheme_Object *form,
             && !SCHEME_BIGNUMP(a_mode))
           scheme_wrong_syntax(NULL, i, form, "bad `%s-meta' level specification",
                               (SAME_OBJ(for_meta_symbol, aav) ? "for" : "just"));
-        if (SAME_OBJ(for_meta_symbol, aav)) 
-          mode = a_mode;
-        else
+        if (SAME_OBJ(for_meta_symbol, aav))  {
+          if (SCHEME_FALSEP(a_mode))
+            mode = a_mode;
+          else
+            mode = scheme_bin_plus(a_mode, scheme_make_integer(0));
+        } else
           just_mode = a_mode;
       } else {
         if (SAME_OBJ(for_syntax_symbol, aav))
@@ -9202,7 +9696,7 @@ void parse_requires(Scheme_Object *form,
 
       start_module(m, env, 0, idx, 
                    start ? eval_exp : 0, start ? eval_run : 0, 
-                   main_env->phase, scheme_null);
+                   main_env->phase, scheme_null, 0);
 
       /* Add name to require list, if it's not there: */
       if (main_env->module) {
@@ -9236,16 +9730,14 @@ void parse_requires(Scheme_Object *form,
 
       x_just_mode = just_mode;
       x_mode = mode;
-      if (main_env->phase) {
-        /* We get here only via `eval' or `namespace-require'. */
-        if (x_just_mode && SCHEME_TRUEP(x_just_mode)) {
-          x_just_mode = scheme_bin_plus(x_just_mode, scheme_make_integer(main_env->phase));
-        }
+      if (at_phase) {
         if (x_mode && SCHEME_TRUEP(x_mode)) {
-          x_mode = scheme_bin_plus(x_mode, scheme_make_integer(main_env->phase));
+          x_mode = scheme_bin_plus(x_mode, scheme_make_integer(at_phase));
         }
+        /* x_just_mode refers to the mode at export, which doesn't shift 
+           by phase context at import */
       }
-      
+
       add_single_require(m->me, x_just_mode, x_mode, idx, rename_env,
                          rn_set, post_ex_rn_set, NULL,
                          exns, onlys, prefix, iname, ename,
@@ -9344,7 +9836,7 @@ do_require_execute(Scheme_Env *env, Scheme_Object *form)
     ht = NULL;
   }
 
-  parse_requires(form, modidx, env, NULL,
+  parse_requires(form, env->phase, modidx, env, NULL,
                  rn_set, rn_set,
                  check_dup_require, ht,
                  NULL,
@@ -9399,7 +9891,7 @@ static Scheme_Object *do_require(Scheme_Object *form, Scheme_Comp_Env *env,
   else
     modidx = scheme_false;
 
-  parse_requires(form, modidx, genv, NULL,
+  parse_requires(form, genv->phase, modidx, genv, NULL,
                  rn_set, rn_set,
                  check_dup_require, ht,
                  NULL, 
diff --git a/src/racket/src/mzmark_place.inc b/src/racket/src/mzmark_place.inc
index 6d289c240e..fe45335c73 100644
--- a/src/racket/src/mzmark_place.inc
+++ b/src/racket/src/mzmark_place.inc
@@ -127,3 +127,28 @@ static int serialized_file_fd_val_FIXUP(void *p, struct NewGC *gc) {
 #define serialized_file_fd_val_IS_CONST_SIZE 1
 
 
+static int serialized_socket_fd_val_SIZE(void *p, struct NewGC *gc) {
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Serialized_Socket_FD));
+}
+
+static int serialized_socket_fd_val_MARK(void *p, struct NewGC *gc) {
+  Scheme_Serialized_Socket_FD *sfd = (Scheme_Serialized_Socket_FD *) p;
+  gcMARK2(sfd->name, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Serialized_Socket_FD));
+}
+
+static int serialized_socket_fd_val_FIXUP(void *p, struct NewGC *gc) {
+  Scheme_Serialized_Socket_FD *sfd = (Scheme_Serialized_Socket_FD *) p;
+  gcFIXUP2(sfd->name, gc);
+
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Serialized_Socket_FD));
+}
+
+#define serialized_socket_fd_val_IS_ATOMIC 0
+#define serialized_socket_fd_val_IS_CONST_SIZE 1
+
+
diff --git a/src/racket/src/mzmark_type.inc b/src/racket/src/mzmark_type.inc
index 3ab370bf96..94d5c422c6 100644
--- a/src/racket/src/mzmark_type.inc
+++ b/src/racket/src/mzmark_type.inc
@@ -2167,6 +2167,7 @@ static int namespace_val_MARK(void *p, struct NewGC *gc) {
   gcMARK2(e->exp_env, gc);
   gcMARK2(e->template_env, gc);
   gcMARK2(e->label_env, gc);
+  gcMARK2(e->instance_env, gc);
 
   gcMARK2(e->shadowed_syntax, gc);
 
@@ -2176,6 +2177,7 @@ static int namespace_val_MARK(void *p, struct NewGC *gc) {
   gcMARK2(e->tt_require_names, gc);
   gcMARK2(e->dt_require_names, gc);
   gcMARK2(e->other_require_names, gc);
+  gcMARK2(e->running, gc);
   gcMARK2(e->did_starts, gc);
   gcMARK2(e->available_next[0], gc);
   gcMARK2(e->available_next[1], gc);
@@ -2206,6 +2208,7 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(e->exp_env, gc);
   gcFIXUP2(e->template_env, gc);
   gcFIXUP2(e->label_env, gc);
+  gcFIXUP2(e->instance_env, gc);
 
   gcFIXUP2(e->shadowed_syntax, gc);
 
@@ -2215,6 +2218,7 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(e->tt_require_names, gc);
   gcFIXUP2(e->dt_require_names, gc);
   gcFIXUP2(e->other_require_names, gc);
+  gcFIXUP2(e->running, gc);
   gcFIXUP2(e->did_starts, gc);
   gcFIXUP2(e->available_next[0], gc);
   gcFIXUP2(e->available_next[1], gc);
@@ -2508,24 +2512,14 @@ static int module_val_MARK(void *p, struct NewGC *gc) {
   gcMARK2(m->dt_requires, gc);
   gcMARK2(m->other_requires, gc);
 
-  gcMARK2(m->body, gc);
-  gcMARK2(m->et_body, gc);
+  gcMARK2(m->bodies, gc);
 
   gcMARK2(m->me, gc);
 
-  gcMARK2(m->provide_protects, gc);
-  gcMARK2(m->indirect_provides, gc);
-
-  gcMARK2(m->indirect_syntax_provides, gc);
-
-  gcMARK2(m->et_provide_protects, gc);
-  gcMARK2(m->et_indirect_provides, gc);
+  gcMARK2(m->exp_infos, gc);
 
   gcMARK2(m->self_modidx, gc);
 
-  gcMARK2(m->accessible, gc);
-  gcMARK2(m->et_accessible, gc);
-
   gcMARK2(m->insp, gc);
 
   gcMARK2(m->lang_info, gc);
@@ -2558,24 +2552,14 @@ static int module_val_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(m->dt_requires, gc);
   gcFIXUP2(m->other_requires, gc);
 
-  gcFIXUP2(m->body, gc);
-  gcFIXUP2(m->et_body, gc);
+  gcFIXUP2(m->bodies, gc);
 
   gcFIXUP2(m->me, gc);
 
-  gcFIXUP2(m->provide_protects, gc);
-  gcFIXUP2(m->indirect_provides, gc);
-
-  gcFIXUP2(m->indirect_syntax_provides, gc);
-
-  gcFIXUP2(m->et_provide_protects, gc);
-  gcFIXUP2(m->et_indirect_provides, gc);
+  gcFIXUP2(m->exp_infos, gc);
 
   gcFIXUP2(m->self_modidx, gc);
 
-  gcFIXUP2(m->accessible, gc);
-  gcFIXUP2(m->et_accessible, gc);
-
   gcFIXUP2(m->insp, gc);
 
   gcFIXUP2(m->lang_info, gc);
@@ -2598,6 +2582,41 @@ static int module_val_FIXUP(void *p, struct NewGC *gc) {
 #define module_val_IS_CONST_SIZE 1
 
 
+static int exp_info_val_SIZE(void *p, struct NewGC *gc) {
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
+}
+
+static int exp_info_val_MARK(void *p, struct NewGC *gc) {
+  Scheme_Module_Export_Info *m = (Scheme_Module_Export_Info *)p;
+
+  gcMARK2(m->provide_protects, gc);
+  gcMARK2(m->indirect_provides, gc);
+
+  gcMARK2(m->indirect_syntax_provides, gc);
+
+  gcMARK2(m->accessible, gc);
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
+}
+
+static int exp_info_val_FIXUP(void *p, struct NewGC *gc) {
+  Scheme_Module_Export_Info *m = (Scheme_Module_Export_Info *)p;
+
+  gcFIXUP2(m->provide_protects, gc);
+  gcFIXUP2(m->indirect_provides, gc);
+
+  gcFIXUP2(m->indirect_syntax_provides, gc);
+
+  gcFIXUP2(m->accessible, gc);
+  return
+  gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
+}
+
+#define exp_info_val_IS_ATOMIC 0
+#define exp_info_val_IS_CONST_SIZE 1
+
+
 static int module_phase_exports_val_SIZE(void *p, struct NewGC *gc) {
   return
   gcBYTES_TO_WORDS(sizeof(Scheme_Module_Phase_Exports));
diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c
index 521dc4d6b2..cb7fa8e498 100644
--- a/src/racket/src/mzmarksrc.c
+++ b/src/racket/src/mzmarksrc.c
@@ -876,6 +876,7 @@ namespace_val {
   gcMARK2(e->exp_env, gc);
   gcMARK2(e->template_env, gc);
   gcMARK2(e->label_env, gc);
+  gcMARK2(e->instance_env, gc);
 
   gcMARK2(e->shadowed_syntax, gc);
 
@@ -885,6 +886,7 @@ namespace_val {
   gcMARK2(e->tt_require_names, gc);
   gcMARK2(e->dt_require_names, gc);
   gcMARK2(e->other_require_names, gc);
+  gcMARK2(e->running, gc);
   gcMARK2(e->did_starts, gc);
   gcMARK2(e->available_next[0], gc);
   gcMARK2(e->available_next[1], gc);
@@ -1009,24 +1011,14 @@ module_val {
   gcMARK2(m->dt_requires, gc);
   gcMARK2(m->other_requires, gc);
 
-  gcMARK2(m->body, gc);
-  gcMARK2(m->et_body, gc);
+  gcMARK2(m->bodies, gc);
 
   gcMARK2(m->me, gc);
 
-  gcMARK2(m->provide_protects, gc);
-  gcMARK2(m->indirect_provides, gc);
-
-  gcMARK2(m->indirect_syntax_provides, gc);
-
-  gcMARK2(m->et_provide_protects, gc);
-  gcMARK2(m->et_indirect_provides, gc);
+  gcMARK2(m->exp_infos, gc);
 
   gcMARK2(m->self_modidx, gc);
 
-  gcMARK2(m->accessible, gc);
-  gcMARK2(m->et_accessible, gc);
-
   gcMARK2(m->insp, gc);
 
   gcMARK2(m->lang_info, gc);
@@ -1045,6 +1037,20 @@ module_val {
   gcBYTES_TO_WORDS(sizeof(Scheme_Module));
 }
 
+exp_info_val {
+ mark:
+  Scheme_Module_Export_Info *m = (Scheme_Module_Export_Info *)p;
+
+  gcMARK2(m->provide_protects, gc);
+  gcMARK2(m->indirect_provides, gc);
+
+  gcMARK2(m->indirect_syntax_provides, gc);
+
+  gcMARK2(m->accessible, gc);
+ size:
+  gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
+}
+
 module_phase_exports_val {
  mark:
   Scheme_Module_Phase_Exports *m = (Scheme_Module_Phase_Exports *)p;
@@ -1478,6 +1484,15 @@ serialized_file_fd_val {
   gcBYTES_TO_WORDS(sizeof(Scheme_Serialized_File_FD));
 }
 
+serialized_socket_fd_val {
+ mark:
+  Scheme_Serialized_Socket_FD *sfd = (Scheme_Serialized_Socket_FD *) p;
+  gcMARK2(sfd->name, gc);
+
+ size:
+  gcBYTES_TO_WORDS(sizeof(Scheme_Serialized_Socket_FD));
+}
+
 END place;
 
 /**********************************************************************/
diff --git a/src/racket/src/network.c b/src/racket/src/network.c
index c11d8ec563..37e7b09c38 100644
--- a/src/racket/src/network.c
+++ b/src/racket/src/network.c
@@ -92,6 +92,10 @@ struct SOCKADDR_IN {
 extern int scheme_stupid_windows_machine;
 #endif
 
+intptr_t scheme_socket_errno() {
+  return SOCK_ERRNO();
+}
+
 #include "schfd.h"
 
 #define TCP_BUFFER_SIZE 4096
@@ -1435,7 +1439,7 @@ tcp_out_buffer_mode(Scheme_Port *p, int mode)
 }
 
 static Scheme_Object *
-make_tcp_input_port(void *data, const char *name, Scheme_Object *cust)
+make_tcp_input_port_symbol_name(void *data, Scheme_Object *name, Scheme_Object *cust)
 {
   Scheme_Input_Port *ip;
 
@@ -1444,7 +1448,7 @@ make_tcp_input_port(void *data, const char *name, Scheme_Object *cust)
   
   ip = scheme_make_input_port(scheme_tcp_input_port_type,
 			      data,
-			      scheme_intern_symbol(name),
+                              name,
 			      tcp_get_string,
 			      NULL,
 			      scheme_progress_evt_via_get,
@@ -1460,7 +1464,13 @@ make_tcp_input_port(void *data, const char *name, Scheme_Object *cust)
 }
 
 static Scheme_Object *
-make_tcp_output_port(void *data, const char *name, Scheme_Object *cust)
+make_tcp_input_port(void *data, const char *name, Scheme_Object *cust)
+{
+  return make_tcp_input_port_symbol_name(data, scheme_intern_symbol(name), cust);
+}
+
+static Scheme_Object *
+make_tcp_output_port_symbol_name(void *data, Scheme_Object *name, Scheme_Object *cust)
 {
   Scheme_Output_Port *op;
 
@@ -1469,7 +1479,7 @@ make_tcp_output_port(void *data, const char *name, Scheme_Object *cust)
 
   op = scheme_make_output_port(scheme_tcp_output_port_type,
 						  data,
-						  scheme_intern_symbol(name),
+						  name,
 						  scheme_write_evt_via_write,
 						  tcp_write_string,
 						  (Scheme_Out_Ready_Fun)tcp_check_write,
@@ -1484,6 +1494,12 @@ make_tcp_output_port(void *data, const char *name, Scheme_Object *cust)
   return (Scheme_Object *)op;
 }
 
+static Scheme_Object *
+make_tcp_output_port(void *data, const char *name, Scheme_Object *cust)
+{
+  return make_tcp_output_port_symbol_name(data, scheme_intern_symbol(name), cust);
+}
+
 #endif /* USE_TCP */
 
 /*========================================================================*/
@@ -2383,6 +2399,10 @@ static Scheme_Object *tcp_abandon_port(int argc, Scheme_Object *argv[])
   return NULL;
 }
 
+void scheme_tcp_abandon_port(Scheme_Object *port) {
+  tcp_abandon_port(1, &port);
+}
+
 static Scheme_Object *tcp_port_p(int argc, Scheme_Object *argv[])
 {
 #ifdef USE_TCP
@@ -2509,19 +2529,67 @@ void scheme_socket_to_ports(intptr_t s, const char *name, int takeover,
   }
 }
 
+void scheme_socket_to_input_port(intptr_t s, Scheme_Object *name, int takeover,
+                                 Scheme_Object **_inp)
+{
+  Scheme_Tcp *tcp;
+  Scheme_Object *v;
+
+  tcp = make_tcp_port_data(s, takeover ? 1 : 2);
+
+  v = make_tcp_input_port_symbol_name(tcp, name, NULL);
+  *_inp = v;
+  
+  if (takeover) {
+    REGISTER_SOCKET(s);
+  }
+}
+
+void scheme_socket_to_output_port(intptr_t s, Scheme_Object *name, int takeover,
+                                  Scheme_Object **_outp)
+{
+  Scheme_Tcp *tcp;
+  Scheme_Object *v;
+
+  tcp = make_tcp_port_data(s, takeover ? 1 : 2);
+
+  v = make_tcp_output_port_symbol_name(tcp, name, NULL);
+  *_outp = v;
+  
+  if (takeover) {
+    REGISTER_SOCKET(s);
+  }
+}
+
 intptr_t scheme_dup_socket(intptr_t fd) {
-#ifdef USE_WINSOCK_TCP
+#ifdef USE_SOCKETS_TCP
+# ifdef USE_WINSOCK_TCP
   intptr_t nsocket;
+  intptr_t rc;
   WSAPROTOCOL_INFO protocolInfo;
-  WSADuplicateSocket(fd, GetCurrentProcessId(), &protocolInfo);
+  rc = WSADuplicateSocket(fd, GetCurrentProcessId(), &protocolInfo);
+  if (rc)
+    return rc;
   nsocket = WSASocket(FROM_PROTOCOL_INFO, FROM_PROTOCOL_INFO, FROM_PROTOCOL_INFO, &protocolInfo, 0, WSA_FLAG_OVERLAPPED);
+  REGISTER_SOCKET(nsocket);
   return nsocket;
-#else
+# else
   intptr_t nfd;
   do {
     nfd = dup(fd);
   } while (nfd == -1 && errno == EINTR);
   return nfd;
+# endif
+#else
+  return -1;
+#endif
+}
+
+void scheme_close_socket_fd(intptr_t fd) 
+{
+#ifdef USE_SOCKETS_TCP
+  UNREGISTER_SOCKET(fd);
+  closesocket(fd);
 #endif
 }
 
diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c
index 28094ffb70..b15d5a49de 100644
--- a/src/racket/src/optimize.c
+++ b/src/racket/src/optimize.c
@@ -2996,7 +2996,7 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context)
   return obj;
 }
 
-static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int for_stx)
+static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info)
 {
   Scheme_Object *val;
   Optimize_Info *einfo;
@@ -3016,12 +3016,29 @@ static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_
 
 static Scheme_Object *define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int context)
 {
-  return do_define_syntaxes_optimize(data, info, 0);
+  return do_define_syntaxes_optimize(data, info);
 }
 
-static Scheme_Object *define_for_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int context)
+static Scheme_Object *begin_for_syntax_optimize(Scheme_Object *data, Optimize_Info *info, int context)
 {
-  return do_define_syntaxes_optimize(data, info, 1);
+  Scheme_Object *l, *a;
+  Optimize_Info *einfo;
+
+  l = SCHEME_VEC_ELS(data)[2];
+
+  while (!SCHEME_NULLP(l)) {
+    einfo = scheme_optimize_info_create();
+    if (info->inline_fuel < 0)
+      einfo->inline_fuel = -1;
+    
+    a = SCHEME_CAR(l);
+    a = scheme_optimize_expr(a, einfo, 0);
+    SCHEME_CAR(l) = a;
+
+    l = SCHEME_CDR(l);
+  }
+
+  return data;
 }
 
 /*========================================================================*/
@@ -4517,7 +4534,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
   old_context = info->context;
   info->context = (Scheme_Object *)m;
 
-  cnt = SCHEME_VEC_SIZE(m->body);
+  cnt = SCHEME_VEC_SIZE(m->bodies[0]);
 
   if (OPT_ESTIMATE_FUTURE_SIZES) {
     if (info->enforce_const) {
@@ -4525,7 +4542,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
          size estimate, which is used to discourage early loop unrolling
          at the expense of later inlining. */
       for (i_m = 0; i_m < cnt; i_m++) {
-        e = SCHEME_VEC_ELS(m->body)[i_m];
+        e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
         if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type))  {
           int n;
 
@@ -4562,7 +4579,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
 
   for (i_m = 0; i_m < cnt; i_m++) {
     /* Optimize this expression: */
-    e = SCHEME_VEC_ELS(m->body)[i_m];
+    e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
 
     is_proc_def = 0;
     if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) {
@@ -4587,7 +4604,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
       info->use_psize = 0;
       info->inline_fuel = inline_fuel;
     }
-    SCHEME_VEC_ELS(m->body)[i_m] = e;
+    SCHEME_VEC_ELS(m->bodies[0])[i_m] = e;
 
     if (info->enforce_const) {
       /* If this expression/definition can't have any side effect
@@ -4717,7 +4734,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
              shift-cloning, since there are no local variables in scope. */
           int old_sz, new_sz;
 
-          e = SCHEME_VEC_ELS(m->body)[start_simltaneous];
+          e = SCHEME_VEC_ELS(m->bodies[0])[start_simltaneous];
 
           if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE) {
             if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
@@ -4730,7 +4747,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
             old_sz = 0;
 
           e = scheme_optimize_expr(e, info, 0);
-	  SCHEME_VEC_ELS(m->body)[start_simltaneous] = e;
+	  SCHEME_VEC_ELS(m->bodies[0])[start_simltaneous] = e;
 
           if (re_consts) {
             /* Install optimized closures into constant table ---
@@ -4809,7 +4826,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
     int can_omit = 0;
     for (i_m = 0; i_m < cnt; i_m++) {
       /* Optimize this expression: */
-      e = SCHEME_VEC_ELS(m->body)[i_m];
+      e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
       if (scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) {
         can_omit++;
       }
@@ -4820,12 +4837,12 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
       vec = scheme_make_vector(cnt - can_omit, NULL);
       for (i_m = 0; i_m < cnt; i_m++) {
         /* Optimize this expression: */
-        e = SCHEME_VEC_ELS(m->body)[i_m];
+        e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
         if (!scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) {
           SCHEME_VEC_ELS(vec)[j++] = e;
         }
       }
-      m->body = vec;
+      m->bodies[0] = vec;
     }
   }
 
@@ -5007,8 +5024,8 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
     return set_optimize(expr, info, context);
   case scheme_define_syntaxes_type:
     return define_syntaxes_optimize(expr, info, context);
-  case scheme_define_for_syntax_type:
-    return define_for_syntaxes_optimize(expr, info, context);
+  case scheme_begin_for_syntax_type:
+    return begin_for_syntax_optimize(expr, info, context);
   case scheme_case_lambda_sequence_type:
     return case_lambda_optimize(expr, info, context);
   case scheme_begin0_sequence_type:
@@ -5225,7 +5242,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
     return expr;
   case scheme_define_values_type:
   case scheme_define_syntaxes_type:
-  case scheme_define_for_syntax_type:
+  case scheme_begin_for_syntax_type:
   case scheme_boxenv_type:
     return NULL;
   case scheme_require_form_type:
@@ -5396,7 +5413,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
   case scheme_boxenv_type:
   case scheme_define_values_type:
   case scheme_define_syntaxes_type:
-  case scheme_define_for_syntax_type:
+  case scheme_begin_for_syntax_type:
   case scheme_require_form_type:
   case scheme_module_type:
     scheme_signal_error("scheme_optimize_shift: no shift available for %d", SCHEME_TYPE(expr));
diff --git a/src/racket/src/place.c b/src/racket/src/place.c
index da45492936..16bb9a2bc1 100644
--- a/src/racket/src/place.c
+++ b/src/racket/src/place.c
@@ -24,6 +24,7 @@ static Scheme_Object* scheme_place_enabled(int argc, Scheme_Object *args[]);
 static Scheme_Object* scheme_place_shared(int argc, Scheme_Object *args[]);
 
 THREAD_LOCAL_DECL(int scheme_current_place_id);
+ROSYM static Scheme_Object *quote_symbol;
 
 #ifdef MZ_USE_PLACES
 
@@ -40,7 +41,8 @@ static int id_counter;
 static mzrt_mutex *id_counter_mutex;
 
 SHARED_OK mz_proc_thread *scheme_master_proc_thread;
-THREAD_LOCAL_DECL(struct Scheme_Place_Object *place_object);
+THREAD_LOCAL_DECL(static struct Scheme_Place_Object *place_object);
+THREAD_LOCAL_DECL(static uintptr_t force_gc_for_place_accounting);
 static Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
 static Scheme_Object *place_wait(int argc, Scheme_Object *args[]);
 static Scheme_Object *place_kill(int argc, Scheme_Object *args[]);
@@ -132,6 +134,8 @@ void scheme_init_place(Scheme_Env *env)
 #endif
   scheme_finish_primitive_module(plenv);
 
+ REGISTER_SO(quote_symbol);
+ quote_symbol = scheme_intern_symbol("quote");
 }
 
 static Scheme_Object* scheme_place_enabled(int argc, Scheme_Object *args[]) {
@@ -166,6 +170,8 @@ typedef struct Place_Start_Data {
   Scheme_Object *current_library_collection_paths;
   mzrt_sema *ready;  /* malloc'ed item */
   struct Scheme_Place_Object *place_obj;   /* malloc'ed item */
+  struct NewGC *parent_gc;
+  Scheme_Object *cust_limit;
 } Place_Start_Data;
 
 static void null_out_runtime_globals() {
@@ -202,6 +208,14 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   Scheme_Object         *collection_paths;
   Scheme_Place_Object   *place_obj;
   mzrt_sema             *ready;
+  struct NewGC          *parent_gc;
+  Scheme_Custodian      *cust;
+  intptr_t              mem_limit;
+
+  /* To avoid runaway place creation, check for termination before continuing. */
+  scheme_thread_block(0.0);
+
+  parent_gc = GC_get_current_instance();
 
   /* create place object */
   place = MALLOC_ONE_TAGGED(Scheme_Place);
@@ -214,19 +228,33 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
     place_obj->parent_signal_handle = handle;
   }
 
+  /* The use_factor partly determines how often a child place notifies
+     a parent place that it is using more memory. If the child
+     notified the parent evey time its memory use increased, that
+     would probably be too often. But notifying every time the memory
+     use doubles isn't good enough, because a long chain of places
+     wouldn't alert parents often enough to limit total memory
+     use. Decreasing the factor for each generation means that the
+     alerts become more frequent as nesting gets deeper. */
+  place_obj->use_factor = (place_object ? (place_object->use_factor / 2) : 1.0);
+
   mzrt_sema_create(&ready, 0);
 
   /* pass critical info to new place */
   place_data = MALLOC_ONE(Place_Start_Data);
   place_data->ready    = ready;
   place_data->place_obj = place_obj;
-
+  place_data->parent_gc = parent_gc;
+  
   {
     Scheme_Object *so;
 
     if (!scheme_is_module_path(args[0]) && !SCHEME_PATHP(args[0])) {
       scheme_wrong_type("dynamic-place", "module-path or path", 0, argc, args);
     }
+    if (SCHEME_PAIRP(args[0]) && SAME_OBJ(SCHEME_CAR(args[0]), quote_symbol)) {
+      scheme_wrong_type("dynamic-place", "non-interactively defined module-path", 0, argc, args);
+    }
     if (!SCHEME_SYMBOLP(args[1])) {
       scheme_wrong_type("dynamic-place", "symbol", 1, argc, args);
     }
@@ -251,11 +279,17 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   collection_paths = places_deep_copy_to_master(collection_paths);
   place_data->current_library_collection_paths = collection_paths;
 
+  cust = scheme_get_current_custodian();
+  mem_limit = GC_get_account_memory_limit(cust);
+  place_data->cust_limit = scheme_make_integer(mem_limit);
+  place_obj->memory_limit = mem_limit;
+  place_obj->parent_need_gc = &force_gc_for_place_accounting;
+
   /* create new place */
   proc_thread = mz_proc_thread_create(place_start_proc, place_data);
 
   if (!proc_thread) {
-      mzrt_sema_destroy(ready);
+    mzrt_sema_destroy(ready);
     scheme_signal_error("place: place creation failed");
   }
 
@@ -271,9 +305,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   place_data->place_obj = NULL;
   
   {
-    Scheme_Custodian *cust;
     Scheme_Custodian_Reference *mref;
-    cust = scheme_get_current_custodian();
     mref = scheme_add_managed(NULL,
                               (Scheme_Object *)place,
                               cust_kill_place,
@@ -282,6 +314,10 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
     place->mref = mref;
   }
 
+#ifdef MZ_PRECISE_GC
+  GC_register_new_thread(place, cust);
+#endif
+
   return (Scheme_Object*) place;
 }
 
@@ -304,13 +340,16 @@ static void do_place_kill(Scheme_Place *place)
     mzrt_mutex_unlock(place_obj->lock);
   }
 
+  scheme_resume_one_place(place);
+
   scheme_remove_managed(place->mref, (Scheme_Object *)place);
   place->place_obj = NULL;
 }
 
-static int do_place_break(Scheme_Place *place) {
+static int do_place_break(Scheme_Place *place) 
+{
   Scheme_Place_Object *place_obj;
-  place_obj = (Scheme_Place_Object*) place->place_obj;
+  place_obj = place->place_obj;
 
   {
     mzrt_mutex_lock(place_obj->lock);
@@ -326,7 +365,8 @@ static int do_place_break(Scheme_Place *place) {
   return 0;
 }
 
-static void cust_kill_place(Scheme_Object *pl, void *notused) {
+static void cust_kill_place(Scheme_Object *pl, void *notused) 
+{
   do_place_kill((Scheme_Place *)pl);
 }
 
@@ -511,7 +551,7 @@ int scheme_get_child_status(int pid, int is_group, int *status) {
     } while ((pid2 == -1) && (errno == EINTR));
 
     if (pid2 > 0)
-      add_child_status(pid, status);
+      add_child_status(pid, scheme_extract_child_status(status));
   }
 
   mzrt_mutex_lock(child_status_lock);
@@ -625,7 +665,7 @@ static void *mz_proc_thread_signal_worker(void *data) {
           free(unused_status);
           unused_status = next;
         } else
-          add_child_status(pid, status);
+          add_child_status(pid, scheme_extract_child_status(status));
       } else {
         if (is_group) {
           prev_unused = unused_status;
@@ -856,15 +896,43 @@ static void bad_place_message(Scheme_Object *so) {
                       so);
 }
 
-static Scheme_Object *make_serialized_tcp_fd(intptr_t fd, intptr_t type) {
-  Scheme_Simple_Object *so;
-  int dupfd;
-  dupfd = scheme_dup_socket(fd);
-  so = scheme_malloc_small_atomic_tagged(sizeof(Scheme_Simple_Object));
-  so->iso.so.type = scheme_serialized_tcp_fd_type;
-  so->u.two_int_val.int1 = type;
-  so->u.two_int_val.int2 = dupfd;
-  return (Scheme_Object *)so;
+static void bad_place_message2(Scheme_Object *so, Scheme_Object *o, int can_raise_exn) {
+  Scheme_Object *l;
+  Scheme_Vector *v = (Scheme_Vector *) o;
+  if (v) {
+    if (SCHEME_VEC_ELS(v)[0]) {
+      l = SCHEME_VEC_ELS(v)[0];
+      while (SCHEME_PAIRP(l)) {
+        scheme_close_file_fd(SCHEME_INT_VAL(SCHEME_CAR(l)));
+        l = SCHEME_CDR(l);
+        SCHEME_USE_FUEL(1);
+      }
+    }
+    if (SCHEME_VEC_ELS(v)[1]) {
+      l = SCHEME_VEC_ELS(v)[0];
+      while (SCHEME_PAIRP(l)) {
+        scheme_close_socket_fd(SCHEME_INT_VAL(SCHEME_CAR(l)));
+        l = SCHEME_CDR(l);
+        SCHEME_USE_FUEL(1);
+      }
+    }
+  }
+  if (can_raise_exn)
+    bad_place_message(so);
+}
+static void push_duped_fd(Scheme_Object **fd_accumulators, intptr_t slot, intptr_t dupfd) {
+  Scheme_Object *tmp;
+  Scheme_Vector *v; 
+  if (fd_accumulators) {
+    if (!*fd_accumulators) {
+      tmp = scheme_make_vector(2, scheme_null);
+      *fd_accumulators = tmp;
+    }
+    v = (Scheme_Vector*) *fd_accumulators;
+    
+    tmp = scheme_make_pair(scheme_make_integer(dupfd), SCHEME_VEC_ELS(v)[slot]);
+    SCHEME_VEC_ELS(v)[slot] = tmp;
+  }
 }
 
 static Scheme_Object *trivial_copy(Scheme_Object *so)
@@ -895,7 +963,8 @@ static Scheme_Object *trivial_copy(Scheme_Object *so)
   return NULL;
 }
 
-static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *ht, int copy, int can_raise_exn) {
+static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *ht, 
+    Scheme_Object **fd_accumulators, intptr_t *delayed_errno, int copy, int can_raise_exn) {
   Scheme_Object *new_so;
 
   new_so = trivial_copy(so);
@@ -918,8 +987,8 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
         Scheme_Object *d;
         n = scheme_rational_numerator(so);
         d = scheme_rational_denominator(so);
-        n = shallow_types_copy(n, NULL, copy, can_raise_exn);
-        d = shallow_types_copy(d, NULL, copy, can_raise_exn);
+        n = shallow_types_copy(n, NULL, fd_accumulators, delayed_errno, copy, can_raise_exn);
+        d = shallow_types_copy(d, NULL, fd_accumulators, delayed_errno, copy, can_raise_exn);
         if (copy)
           new_so = scheme_make_rational(n, d);
       }
@@ -938,8 +1007,8 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
         Scheme_Object *i;
         r = scheme_complex_real_part(so);
         i = scheme_complex_imaginary_part(so);
-        r = shallow_types_copy(r, NULL, copy, can_raise_exn);
-        i = shallow_types_copy(i, NULL, copy, can_raise_exn);
+        r = shallow_types_copy(r, NULL, fd_accumulators, delayed_errno, copy, can_raise_exn);
+        i = shallow_types_copy(i, NULL, fd_accumulators, delayed_errno, copy, can_raise_exn);
         if (copy)
           new_so = scheme_make_complex(r, i);
       }
@@ -965,10 +1034,8 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
       break;
     case scheme_symbol_type:
       if (SCHEME_SYM_UNINTERNEDP(so)) {
-        if (can_raise_exn)
-          bad_place_message(so);
-        else
-          return NULL;
+        bad_place_message2(so, *fd_accumulators, can_raise_exn);
+        return NULL;
       } else {
         if (copy) {
           new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1);
@@ -1024,16 +1091,16 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
           o->type = scheme_cpointer_type;
           SCHEME_CPTR_FLAGS(o) |= 0x1;
           SCHEME_CPTR_VAL(o) = SCHEME_CPTR_VAL(so);
-          o2 = shallow_types_copy(SCHEME_CPTR_TYPE(so), NULL, copy, can_raise_exn);
+          o2 = shallow_types_copy(SCHEME_CPTR_TYPE(so), NULL, fd_accumulators, delayed_errno, copy, can_raise_exn);
           SCHEME_CPTR_TYPE(o) = o2;
 
           new_so = o;
         }
       }
-      else if (can_raise_exn)
-        bad_place_message(so);
-      else
+      else {
+        bad_place_message2(so, *fd_accumulators, can_raise_exn);
         return NULL;
+      }
       break;
     case scheme_input_port_type:
     case scheme_output_port_type:
@@ -1041,7 +1108,30 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
         intptr_t fd;
         if(scheme_get_port_socket(so, &fd)) {
           if (copy) {
-            new_so = make_serialized_tcp_fd(fd, so->type);
+            Scheme_Object *tmp;
+            Scheme_Object *portname;
+            Scheme_Serialized_Socket_FD *ssfd;
+            int dupfd;
+            dupfd = scheme_dup_socket(fd);
+            if (dupfd == -1) {
+              if (can_raise_exn)
+                scheme_raise_exn(MZEXN_FAIL_NETWORK, "dup: error duplicating socket(%e)", scheme_socket_errno());
+              if (delayed_errno) {
+                intptr_t tmp;
+                tmp = scheme_socket_errno();
+                *delayed_errno = tmp;
+              }
+              return NULL;
+            }
+            push_duped_fd(fd_accumulators, 1, dupfd);
+            ssfd = scheme_malloc_tagged(sizeof(Scheme_Serialized_Socket_FD));
+            ssfd->so.type = scheme_serialized_tcp_fd_type;
+            ssfd->type = so->type;
+            ssfd->fd = dupfd;
+            portname = scheme_port_name(so);
+            tmp = shallow_types_copy(portname, ht, fd_accumulators, delayed_errno, copy, can_raise_exn);
+            ssfd->name = tmp;
+            return (Scheme_Object *)ssfd;
           }
         }
         else if (SCHEME_TRUEP(scheme_file_stream_port_p(1, &so))) {
@@ -1052,34 +1142,55 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
             sffd = scheme_malloc_tagged(sizeof(Scheme_Serialized_File_FD));
             sffd->so.type = scheme_serialized_file_fd_type;
             scheme_get_serialized_fd_flags(so, sffd);
-            if (sffd->name) {
-              tmp = shallow_types_copy(sffd->name, ht, copy, can_raise_exn);
-              sffd->name = tmp;
-            }
+            tmp = shallow_types_copy(sffd->name, ht, fd_accumulators, delayed_errno, copy, can_raise_exn);
+            sffd->name = tmp;
             dupfd = scheme_dup_file(fd);
+            if (dupfd == -1) {
+              if (can_raise_exn)
+                scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, "dup: error duplicating file descriptor(%e)", scheme_errno());
+              if (delayed_errno) {
+                intptr_t tmp;
+                tmp = scheme_errno();
+                *delayed_errno = tmp;
+              }
+              return NULL;
+            }
+            push_duped_fd(fd_accumulators, 0, dupfd);
             sffd->fd = dupfd;
             sffd->type = so->type;
             new_so = (Scheme_Object *) sffd;
           }
-          else if (can_raise_exn)
-            bad_place_message(so);
-          else
+          else {
+            bad_place_message2(so, *fd_accumulators, can_raise_exn);
             return NULL;
+          }
         }
-        else if (can_raise_exn)
-          bad_place_message(so);
-        else
+        else {
+          bad_place_message2(so, *fd_accumulators, can_raise_exn);
           return NULL;
+        }
       }
       break;
     case scheme_serialized_tcp_fd_type:
       {
         Scheme_Object *in;
         Scheme_Object *out;
-        int type = ((Scheme_Simple_Object *) so)->u.two_int_val.int1;
-        int fd   = ((Scheme_Simple_Object *) so)->u.two_int_val.int2;
-        scheme_socket_to_ports(fd, "", 1, &in, &out);
-        new_so = (type == scheme_input_port_type) ? in : out;
+        Scheme_Object *name;
+        int type = ((Scheme_Serialized_Socket_FD *) so)->type;
+        int fd   = ((Scheme_Serialized_Socket_FD *) so)->fd;
+        name = ((Scheme_Serialized_Socket_FD *) so)->name;
+
+        //scheme_socket_to_ports(fd, "tcp-accepted", 1, &in, &out);
+        if (type == scheme_input_port_type) {
+          scheme_socket_to_input_port(fd, name, 1, &in);
+          //scheme_tcp_abandon_port(out);
+          new_so = in;
+        }
+        else {
+          scheme_socket_to_output_port(fd, name, 1, &out);
+          //scheme_tcp_abandon_port(in);
+          new_so = out;
+        }
       }
       break;
     case scheme_serialized_file_fd_type:
@@ -1256,6 +1367,9 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
   Scheme_Object *inf_stack = NULL;
   Scheme_Object *reg0 = NULL;
   uintptr_t inf_stack_depth = 0;
+
+  Scheme_Object *fd_accumulators = NULL;
+  intptr_t delayed_errno = 0;
   
   /* lifted variables for xform*/
   Scheme_Object *pair;
@@ -1292,7 +1406,7 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
   int ctr = 0;
 
   /* First, check for simple values that don't need to be hashed: */
-  new_so = shallow_types_copy(so, *ht, copy, can_raise_exn);
+  new_so = shallow_types_copy(so, *ht, &fd_accumulators, &delayed_errno, copy, can_raise_exn);
   if (new_so) return new_so;
 
   if (*ht) {
@@ -1328,7 +1442,7 @@ DEEP_DO:
     }
   }
 
-  new_so = shallow_types_copy(so, *ht, copy, can_raise_exn);
+  new_so = shallow_types_copy(so, *ht, &fd_accumulators, &delayed_errno, copy, can_raise_exn);
   if (new_so) RETURN;
   new_so = so;
 
@@ -1429,21 +1543,15 @@ DEEP_VEC2:
       local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0);
 
       if (!stype->prefab_key) {
-        if (can_raise_exn)
-          bad_place_message(so);
-        else {
-          new_so = NULL;
-          ABORT;
-        }
+        bad_place_message2(so, fd_accumulators, can_raise_exn);
+        new_so = NULL;
+        ABORT;
       }
       for (i = 0; i < local_slots; i++) {
         if (!stype->immutables || stype->immutables[i] != 1) {
-          if (can_raise_exn)
-            bad_place_message(so);
-          else {
-            new_so = NULL;
-            ABORT;
-          }
+          bad_place_message2(so, fd_accumulators, can_raise_exn);
+          new_so = NULL;
+          ABORT;
         }
       }
 
@@ -1561,12 +1669,11 @@ DEEP_SST2_L:
       }
       break;
     default:
-      if (can_raise_exn)
-        bad_place_message(so);
-      else {
-        new_so = NULL;
-        ABORT;
-      }
+      if (delayed_errno)
+        scheme_warning("Error serializing place message: %e", delayed_errno);
+      bad_place_message2(so, fd_accumulators, can_raise_exn);
+      new_so = NULL;
+      ABORT;
       break;
   }
 
@@ -1661,28 +1768,121 @@ static void *place_start_proc(void *data_arg) {
   return rc;
 }
 
+void scheme_pause_one_place(Scheme_Place *p)
+{
+  Scheme_Place_Object *place_obj = p->place_obj;
+
+  if (place_obj) {
+    mzrt_mutex_lock(place_obj->lock);
+    if (!place_obj->pause) {
+      mzrt_sema *s;
+      mzrt_sema_create(&s, 0);
+      place_obj->pause = s;
+    }
+    mzrt_mutex_unlock(place_obj->lock);
+  }
+}
+
+void scheme_resume_one_place(Scheme_Place *p)
+{
+  Scheme_Place_Object *place_obj = p->place_obj;
+
+  if (place_obj) {
+    mzrt_mutex_lock(place_obj->lock);
+    if (place_obj->pause) {
+      mzrt_sema *s = place_obj->pause;
+      place_obj->pause = NULL;
+      if (!place_obj->pausing) {
+        mzrt_sema_destroy(s);
+      } else {
+        mzrt_sema_post(s);
+      }
+    }
+    mzrt_mutex_unlock(place_obj->lock);
+  }
+}
+
 void scheme_place_check_for_interruption() 
 {
   Scheme_Place_Object *place_obj;
   char local_die;
   char local_break;
+  mzrt_sema *local_pause;
+
+  place_obj = place_object;
+  if (!place_obj)
+    return;
+  
+  while (1) {
+    mzrt_mutex_lock(place_obj->lock);
+  
+    local_die = place_obj->die;
+    local_break = place_obj->pbreak;
+    local_pause = place_obj->pause;
+    place_obj->pbreak = 0;
+    if (local_pause)
+      place_obj->pausing = 1;
+    
+    mzrt_mutex_unlock(place_obj->lock);
+    
+    if (local_pause) {
+      scheme_pause_all_places();
+      mzrt_sema_wait(local_pause);
+      mzrt_sema_destroy(local_pause);
+      scheme_resume_all_places();
+    } else
+      break;
+  }
+  
+  if (local_die)
+    scheme_kill_thread(scheme_main_thread);
+  if (local_break)
+    scheme_break_thread(NULL);
+}
+
+void scheme_place_set_memory_use(intptr_t mem_use)
+{
+  Scheme_Place_Object *place_obj;
 
   place_obj = place_object;
   if (!place_obj)
     return;
 
   mzrt_mutex_lock(place_obj->lock);
-  
-  local_die = place_obj->die;
-  local_break = place_obj->pbreak;
-  place_obj->pbreak = 0;
-  
+  place_obj->memory_use = mem_use;
   mzrt_mutex_unlock(place_obj->lock);
-  
-  if (local_die)
-    scheme_kill_thread(scheme_main_thread);
-  if (local_break)
-    scheme_break_thread(NULL);
+
+  if (place_obj->parent_signal_handle && place_obj->memory_limit) {
+    if (mem_use > place_obj->memory_limit) {
+      /* tell the parent place to force a GC, and therefore check
+         custodian limits that will kill this place; pause this
+         place and its children to give the original place time 
+         to kill this one */
+      scheme_pause_all_places();
+      mzrt_ensure_max_cas(place_obj->parent_need_gc, 1);
+      scheme_signal_received_at(place_obj->parent_signal_handle);
+    } else if (mem_use > (1 + place_obj->use_factor) * place_obj->prev_notify_memory_use) {
+      /* make sure the parent notices that we're using more memory: */
+      scheme_signal_received_at(place_obj->parent_signal_handle);
+      place_obj->prev_notify_memory_use = mem_use;
+    } else if (mem_use < place_obj->prev_notify_memory_use) {
+      place_obj->prev_notify_memory_use = mem_use;
+    }
+  }
+}
+
+void scheme_place_check_memory_use()
+{
+  intptr_t m;
+
+  m = GC_propagate_hierarchy_memory_use();
+  scheme_place_set_memory_use(m);
+
+  if (force_gc_for_place_accounting) {
+    force_gc_for_place_accounting = 0;
+    scheme_collect_garbage();
+    scheme_resume_all_places();
+  }
 }
 
 static void place_set_result(Scheme_Object *result)
@@ -1724,6 +1924,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
   Scheme_Place_Object *place_obj;
   Scheme_Object *place_main;
   Scheme_Object *a[2], *channel;
+  intptr_t mem_limit;
   mzrt_thread_id ptid;
   ptid = mz_proc_thread_self();
   
@@ -1739,8 +1940,10 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
   scheme_current_place_id = ++id_counter;
   mzrt_mutex_unlock(id_counter_mutex);
 
+  mem_limit = SCHEME_INT_VAL(place_data->cust_limit);
+  
   /* scheme_make_thread behaves differently if the above global vars are not null */
-  scheme_place_instance_init(stack_base);
+  scheme_place_instance_init(stack_base, place_data->parent_gc, mem_limit);
 
   a[0] = scheme_places_deep_copy(place_data->current_library_collection_paths);
   scheme_current_library_collection_paths(1, a);
@@ -1904,6 +2107,7 @@ static void places_deserialize_clean_worker(Scheme_Object **pso, Scheme_Hash_Tab
     case scheme_integer_type:
     case scheme_place_bi_channel_type: /* allocated in the master and can be passed along as is */
     case scheme_char_type:
+    case scheme_bignum_type:
     case scheme_rational_type:
     case scheme_float_type:
     case scheme_double_type:
@@ -1928,19 +2132,10 @@ static void places_deserialize_clean_worker(Scheme_Object **pso, Scheme_Hash_Tab
         Scheme_Object *in;
         Scheme_Object *out;
         int fd   = ((Scheme_Simple_Object *) so)->u.two_int_val.int2;
-# ifdef USE_WINSOCK_TCP
-        close(fd);
-# else
-        {
-          intptr_t rc;
-          do {
-            rc = close(fd);
-          } while (rc == -1 && errno == EINTR);
-        }
-# endif
+        scheme_close_socket_fd(fd);
       }
       else {
-        tmp = shallow_types_copy(so, NULL, 1, 1);
+        tmp = shallow_types_copy(so, NULL, NULL, NULL, 1, 1);
         *pso = tmp;
       }
       break;
@@ -1948,19 +2143,10 @@ static void places_deserialize_clean_worker(Scheme_Object **pso, Scheme_Hash_Tab
       if (clean) {
         Scheme_Serialized_File_FD *sffd;
         sffd = (Scheme_Serialized_File_FD *) so;
-#ifdef WINDOWS_FILE_HANDLES
-        CloseHandle((HANDLE)sffd->fd);
-#else
-        {
-          intptr_t rc;
-          do {
-            rc = close(sffd->fd);
-          } while (rc == -1 && errno == EINTR);
-        }
-#endif
+        scheme_close_file_fd(sffd->fd);
       }
       else {
-        tmp = shallow_types_copy(so, NULL, 1, 1);
+        tmp = shallow_types_copy(so, NULL, NULL, NULL, 1, 1);
         *pso = tmp;
       }
       break;
@@ -2528,6 +2714,7 @@ static void register_traversers(void)
   GC_REG_TRAV(scheme_place_async_channel_type, place_async_channel_val);
   GC_REG_TRAV(scheme_place_bi_channel_type, place_bi_channel_val);
   GC_REG_TRAV(scheme_serialized_file_fd_type, serialized_file_fd_val);
+  GC_REG_TRAV(scheme_serialized_tcp_fd_type, serialized_socket_fd_val);
 }
 
 END_XFORM_SKIP;
diff --git a/src/racket/src/port.c b/src/racket/src/port.c
index 0602c4d9e6..357b12d7e0 100644
--- a/src/racket/src/port.c
+++ b/src/racket/src/port.c
@@ -286,6 +286,13 @@ typedef struct Scheme_FD {
 # endif
 } Scheme_FD;
 
+Scheme_Object *scheme_port_name(Scheme_Object *p) {
+  if (p->type == scheme_input_port_type)
+    return ((Scheme_Input_Port *)p)->name;
+  else
+    return ((Scheme_Output_Port *)p)->name;
+}
+
 int scheme_get_serialized_fd_flags(Scheme_Object* p, Scheme_Serialized_File_FD *so) {
   Scheme_FD *fds;
   if (p->type == scheme_input_port_type) {
@@ -294,7 +301,7 @@ int scheme_get_serialized_fd_flags(Scheme_Object* p, Scheme_Serialized_File_FD *
   }
   else {
     fds = (Scheme_FD *) ((Scheme_Output_Port *)p)->port_data;
-    so->name = ((Scheme_Input_Port *)p)->name;
+    so->name = ((Scheme_Output_Port *)p)->name;
   }
   so->regfile = fds->regfile;
   so->textmode = fds->textmode;
@@ -1209,6 +1216,19 @@ intptr_t scheme_dup_file(intptr_t fd) {
 #endif
 }
 
+void scheme_close_file_fd(intptr_t fd) {
+#ifdef WINDOWS_FILE_HANDLES
+  CloseHandle((HANDLE)fd);
+#else
+  {
+    intptr_t rc;
+    do {
+      rc = close(fd);
+    } while (rc == -1 && errno == EINTR);
+  }
+#endif
+}
+
 
 /*========================================================================*/
 /*                      Windows thread suspension                         */
@@ -7428,14 +7448,7 @@ static void check_child_done(pid_t pid)
           unused = (void **)next;
         }
 
-        START_XFORM_SKIP;
-        if (WIFEXITED(status))
-          status = WEXITSTATUS(status);
-        else if (WIFSIGNALED(status))
-          status = WTERMSIG(status) + 128;
-        else
-          status = MZ_FAILURE_STATUS;
-        END_XFORM_SKIP;
+        status = scheme_extract_child_status(status);
 
         prev = NULL;
         for (sc = scheme_system_children; sc; prev = sc, sc = sc->next) {
@@ -7469,6 +7482,20 @@ void scheme_check_child_done(void)
 
 #endif
 
+#if defined(UNIX_PROCESSES)
+int scheme_extract_child_status(int status) XFORM_SKIP_PROC
+{
+  if (WIFEXITED(status))
+    status = WEXITSTATUS(status);
+  else if (WIFSIGNALED(status))
+    status = WTERMSIG(status) + 128;
+  else
+    status = MZ_FAILURE_STATUS;
+
+  return status;
+}
+#endif
+
 /*========================================================================*/
 /*                           null output ports                            */
 /*========================================================================*/
diff --git a/src/racket/src/resolve.c b/src/racket/src/resolve.c
index 644912cc5d..6f2571fcc5 100644
--- a/src/racket/src/resolve.c
+++ b/src/racket/src/resolve.c
@@ -729,7 +729,7 @@ case_lambda_resolve(Scheme_Object *expr, Resolve_Info *rslv)
   return expr;
 }
 
-static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info, int for_stx)
+static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info)
 {
   Comp_Prefix *cp;
   Resolve_Prefix *rp;
@@ -748,8 +748,6 @@ static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_In
 
   einfo = scheme_resolve_info_create(rp);
 
-  if (for_stx)
-    names = scheme_resolve_list(names, einfo);
   val = scheme_resolve_expr(val, einfo);
 
   rp = scheme_remap_prefix(rp, einfo);
@@ -770,19 +768,54 @@ static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_In
     names = SCHEME_CDR(names);
   }
 
-  vec->type = (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type);
+  vec->type = scheme_define_syntaxes_type;
 
   return vec;
 }
 
 static Scheme_Object *define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info)
 {
-  return do_define_syntaxes_resolve(data, info, 0);
+  return do_define_syntaxes_resolve(data, info);
 }
 
-static Scheme_Object *define_for_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info)
+static Scheme_Object *begin_for_syntax_resolve(Scheme_Object *data, Resolve_Info *info)
 {
-  return do_define_syntaxes_resolve(data, info, 1);
+  Comp_Prefix *cp;
+  Resolve_Prefix *rp;
+  Scheme_Object *l, *p, *a, *base_stack_depth, *dummy, *vec;
+  Resolve_Info *einfo;
+
+  cp = (Comp_Prefix *)SCHEME_VEC_ELS(data)[0];
+  dummy = SCHEME_VEC_ELS(data)[1];
+  l = SCHEME_VEC_ELS(data)[2];
+
+  rp = scheme_resolve_prefix(1, cp, 1);
+
+  dummy = scheme_resolve_expr(dummy, info);
+
+  einfo = scheme_resolve_info_create(rp);
+
+  p = scheme_null;
+  while (!SCHEME_NULLP(l)) {
+    a = SCHEME_CAR(l);
+    a = scheme_resolve_expr(a, einfo);
+    p = scheme_make_pair(a, p);
+    l = SCHEME_CDR(l);
+  }
+  l = scheme_reverse(p);
+  
+  rp = scheme_remap_prefix(rp, einfo);
+
+  base_stack_depth = scheme_make_integer(einfo->max_let_depth);
+  
+  vec = scheme_make_vector(4, NULL);
+  SCHEME_VEC_ELS(vec)[0] = l;
+  SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)rp;
+  SCHEME_VEC_ELS(vec)[2] = base_stack_depth;
+  SCHEME_VEC_ELS(vec)[3] = dummy;
+  vec->type = scheme_begin_for_syntax_type;
+
+  return vec;
 }
 
 /*========================================================================*/
@@ -2152,20 +2185,20 @@ module_expr_resolve(Scheme_Object *data, Resolve_Info *old_rslv)
   rslv->in_module = 1;
   scheme_enable_expression_resolve_lifts(rslv);
 
-  cnt = SCHEME_VEC_SIZE(m->body);
+  cnt = SCHEME_VEC_SIZE(m->bodies[0]);
   for (i = 0; i < cnt; i++) {
     Scheme_Object *e;
-    e = scheme_resolve_expr(SCHEME_VEC_ELS(m->body)[i], rslv);
-    SCHEME_VEC_ELS(m->body)[i] = e;
+    e = scheme_resolve_expr(SCHEME_VEC_ELS(m->bodies[0])[i], rslv);
+    SCHEME_VEC_ELS(m->bodies[0])[i] = e;
   }
 
   m->max_let_depth = rslv->max_let_depth;
 
   lift_vec = rslv->lifts;
   if (!SCHEME_NULLP(SCHEME_VEC_ELS(lift_vec)[0])) {
-    b = scheme_append(SCHEME_VEC_ELS(lift_vec)[0], scheme_vector_to_list(m->body));
+    b = scheme_append(SCHEME_VEC_ELS(lift_vec)[0], scheme_vector_to_list(m->bodies[0]));
     b = scheme_list_to_vector(b);
-    m->body = b;
+    m->bodies[0] = b;
   }
   rp->num_lifts = SCHEME_INT_VAL(SCHEME_VEC_ELS(lift_vec)[1]);
 
@@ -2288,8 +2321,8 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info)
     return define_values_resolve(expr, info);
   case scheme_define_syntaxes_type:
     return define_syntaxes_resolve(expr, info);
-  case scheme_define_for_syntax_type:
-    return define_for_syntaxes_resolve(expr, info);
+  case scheme_begin_for_syntax_type:
+    return begin_for_syntax_resolve(expr, info);
   case scheme_set_bang_type:
     return set_resolve(expr, info);
   case scheme_require_form_type:
diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h
index f1368ee924..48ca03b7f1 100644
--- a/src/racket/src/schpriv.h
+++ b/src/racket/src/schpriv.h
@@ -398,7 +398,7 @@ extern Scheme_Object *scheme_begin_stx;
 extern Scheme_Object *scheme_module_begin_stx;
 extern Scheme_Object *scheme_define_values_stx;
 extern Scheme_Object *scheme_define_syntaxes_stx;
-extern Scheme_Object *scheme_define_for_syntaxes_stx;
+extern Scheme_Object *scheme_begin_for_syntax_stx;
 extern Scheme_Object *scheme_top_stx;
 
 extern Scheme_Object *scheme_recur_symbol, *scheme_display_symbol, *scheme_write_special_symbol;
@@ -514,6 +514,7 @@ void scheme_kickoff_green_thread_time_slice_timer(intptr_t usec);
 #ifdef UNIX_PROCESSES
 void scheme_block_child_signals(int block);
 void scheme_check_child_done(void);
+int scheme_extract_child_status(int status);
 #endif
 
 void scheme_prepare_this_thread_for_GC(Scheme_Thread *t);
@@ -2671,7 +2672,7 @@ struct Start_Module_Args;
 
 #ifdef MZ_USE_JIT
 void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name);
-void *scheme_module_exprun_start(Scheme_Env *menv, int set_ns, Scheme_Object *name);
+void *scheme_module_exprun_start(Scheme_Env *menv, int phase_plus_set_ns, Scheme_Object *name);
 void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name);
 #endif
 void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env);
@@ -2930,6 +2931,7 @@ struct Scheme_Env {
   struct Scheme_Env *exp_env;
   struct Scheme_Env *template_env;
   struct Scheme_Env *label_env;
+  struct Scheme_Env *instance_env; /* shortcut to env where module is instantiated */
 
   Scheme_Hash_Table *shadowed_syntax; /* top level only */
 
@@ -2938,7 +2940,8 @@ struct Scheme_Env {
   Scheme_Object *link_midx;
   Scheme_Object *require_names, *et_require_names, *tt_require_names, *dt_require_names; /* resolved */
   Scheme_Hash_Table *other_require_names;
-  char running, et_running, attached, ran;
+  char *running; /* array of size `num_phases' if `module' and `mod_phase==0' */
+  char attached, ran;
   Scheme_Object *did_starts;
   Scheme_Object *available_next[2];
 
@@ -2963,6 +2966,19 @@ struct Scheme_Env {
 /* A Scheme_Module corresponds to a module declaration. A module
    instantiation is reprsented by a Scheme_Env */
 
+typedef struct Scheme_Module_Export_Info {
+  MZTAG_IF_REQUIRED
+  char *provide_protects;            /* 1 => protected, 0 => not */
+  Scheme_Object **indirect_provides; /* symbols (internal names) */
+  int num_indirect_provides;
+
+  /* Only if needed to reconstruct the renaming: */
+  Scheme_Object **indirect_syntax_provides; /* symbols (internal names) */
+  int num_indirect_syntax_provides;
+
+  Scheme_Hash_Table *accessible; /* (symbol -> ...) */
+} Scheme_Module_Export_Info;
+
 typedef struct Scheme_Module
 {
   Scheme_Object so; /* scheme_module_type */
@@ -2981,29 +2997,17 @@ typedef struct Scheme_Module
   Scheme_Invoke_Proc prim_body;
   Scheme_Invoke_Proc prim_et_body;
 
-  Scheme_Object *body;        /* or data, if prim_body */
-  Scheme_Object *et_body;     /* list of (vector list-of-names expr depth-int resolve-prefix) */
+  Scheme_Object **bodies; /* array `num_phases' long */
 
   char no_cert;
   
   struct Scheme_Module_Exports *me;
 
-  char *provide_protects;            /* 1 => protected, 0 => not */
-  Scheme_Object **indirect_provides; /* symbols (internal names) */
-  int num_indirect_provides;
-
-  /* Only if needed to reconstruct the renaming: */
-  Scheme_Object **indirect_syntax_provides; /* symbols (internal names) */
-  int num_indirect_syntax_provides;
-
-  char *et_provide_protects;            /* 1 => protected, 0 => not */
-  Scheme_Object **et_indirect_provides; /* symbols (internal names) */
-  int num_indirect_et_provides;
+  int num_phases;
+  Scheme_Module_Export_Info **exp_infos; /* array `num_phases' long */
 
   Scheme_Object *self_modidx;
 
-  Scheme_Hash_Table *accessible; /* (symbol -> ...) */
-  Scheme_Hash_Table *et_accessible; /* phase -> (symbol -> ...) */
   Scheme_Object *insp; /* declaration-time inspector, for module instantiation
                           and enabling access to protected imports */
 
@@ -3035,7 +3039,7 @@ typedef struct Scheme_Module_Phase_Exports
   Scheme_Object **provide_srcs;      /* module access paths, #f for self */
   Scheme_Object **provide_src_names; /* symbols (original internal names) */
   Scheme_Object **provide_nominal_srcs; /* import source if re-exported; NULL or array of lists */
-  char *provide_src_phases;          /* NULL, or src phase for for-syntax import */
+  int *provide_src_phases;          /* NULL, or src phase for for-syntax import */
   int num_provides;
   int num_var_provides;              /* non-syntax listed first in provides */
 
@@ -3141,7 +3145,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
                                                  Scheme_Env *from_env, int *_would_complain,
                                                  Scheme_Object **_is_constant);
 void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env);
-Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name);
+Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name, int mod_phase);
 
 Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
 				   Scheme_Object *shift_from_modidx,
@@ -3482,6 +3486,7 @@ int scheme_byte_ready_or_user_port_ready(Scheme_Object *p, Scheme_Schedule_Info
 
 int scheme_pipe_char_count(Scheme_Object *p);
 void scheme_alloc_global_fdset();
+Scheme_Object *scheme_port_name(Scheme_Object *p);
 
 #define CURRENT_INPUT_PORT(config) scheme_get_param(config, MZCONFIG_INPUT_PORT)
 #define CURRENT_OUTPUT_PORT(config) scheme_get_param(config, MZCONFIG_OUTPUT_PORT)
@@ -3667,19 +3672,29 @@ typedef struct Scheme_Place {
   Scheme_Object *channel;
   Scheme_Custodian_Reference *mref;
   intptr_t result; /* set when place_obj becomes NULL */
+#ifdef MZ_PRECISE_GC
+  struct GC_Thread_Info *gc_info; /* managed by the GC */
+#endif
 } Scheme_Place;
 
 typedef struct Scheme_Place_Object {
   Scheme_Object so;
 #if defined(MZ_USE_PLACES)
   mzrt_mutex *lock;
+  mzrt_sema *pause;
 #endif
   char die;
   char pbreak;
+  char pausing;
   void *signal_handle;
   void *parent_signal_handle; /* set to NULL when the place terminates */
   intptr_t result; /* initialized to 1, reset when parent_signal_handle becomes NULL */
-  /*Thread_Local_Variables *tlvs; */
+
+  intptr_t memory_use; /* set by inform hook on GC, used by GC for memory accounting */
+  intptr_t prev_notify_memory_use; /* if memory_use > use_factor * prev_notify_memory_use, alert parent */
+  double use_factor;
+  intptr_t memory_limit; /* custodian-based limit on the place's memory use */
+  uintptr_t *parent_need_gc; /* ptr to a variable in parent to force a GC (triggering accounting) */
 } Scheme_Place_Object;
 
 typedef struct Scheme_Serialized_File_FD{
@@ -3692,18 +3707,40 @@ typedef struct Scheme_Serialized_File_FD{
   char flush_mode;
 } Scheme_Serialized_File_FD;
 
+typedef struct Scheme_Serialized_Socket_FD{
+  Scheme_Object so;
+  Scheme_Object *name;
+  intptr_t fd;
+  intptr_t type;
+} Scheme_Serialized_Socket_FD;
+
 int scheme_get_serialized_fd_flags(Scheme_Object* p, Scheme_Serialized_File_FD *so);
 intptr_t scheme_dup_socket(intptr_t fd);
 intptr_t scheme_dup_file(intptr_t fd);
-
+void scheme_close_socket_fd(intptr_t fd);
+void scheme_close_file_fd(intptr_t fd);
+void scheme_tcp_abandon_port(Scheme_Object *port);
+intptr_t scheme_socket_errno();
+intptr_t scheme_errno();
+void scheme_socket_to_input_port(intptr_t s, Scheme_Object *name, int takeover, Scheme_Object **_inp);
+void scheme_socket_to_output_port(intptr_t s, Scheme_Object *name, int takeover, Scheme_Object **_outp);
 
 #define SCHEME_PLACE_OBJECTP(o) (SCHEME_TYPE(o) == scheme_place_object_type)
 
-Scheme_Env *scheme_place_instance_init();
+#ifdef MZ_USE_PLACES
+Scheme_Env *scheme_place_instance_init(void *stack_base, struct NewGC *, intptr_t memory_limit);
+#endif
 Scheme_Object *scheme_make_place_object();
 void scheme_place_instance_destroy(int force);
 void scheme_kill_green_thread_timer();
 void scheme_place_check_for_interruption();
 void scheme_check_place_port_ok();
+void scheme_place_set_memory_use(intptr_t amt);
+void scheme_place_check_memory_use();
+
+void scheme_pause_all_places();
+void scheme_pause_one_place(Scheme_Place *p);
+void scheme_resume_all_places();
+void scheme_resume_one_place(Scheme_Place *p);
 
 #endif /* __mzscheme_private__ */
diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h
index cf41c1d243..9a4c0809ba 100644
--- a/src/racket/src/schvers.h
+++ b/src/racket/src/schvers.h
@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.1.3.6"
+#define MZSCHEME_VERSION "5.1.3.7"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 3
-#define MZSCHEME_VERSION_W 6
+#define MZSCHEME_VERSION_W 7
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
diff --git a/src/racket/src/sfs.c b/src/racket/src/sfs.c
index 494c65a29a..cc62b7c9d4 100644
--- a/src/racket/src/sfs.c
+++ b/src/racket/src/sfs.c
@@ -937,9 +937,23 @@ static Scheme_Object *define_syntaxes_sfs(Scheme_Object *data, SFS_Info *info)
   return do_define_syntaxes_sfs(data, info);
 }
 
-static Scheme_Object *define_for_syntaxes_sfs(Scheme_Object *data, SFS_Info *info)
+static Scheme_Object *begin_for_syntax_sfs(Scheme_Object *data, SFS_Info *info)
 {
-  return do_define_syntaxes_sfs(data, info);
+  Scheme_Object *l, *a;
+
+  if (!info->pass) {
+    int depth;
+    depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[2]);
+
+    for (l = SCHEME_VEC_ELS(data)[0]; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
+      a = SCHEME_CAR(l);
+      info = scheme_new_sfs_info(depth);
+      a = scheme_sfs(a, info, depth);
+      SCHEME_CAR(l) = a;
+    }
+  }
+
+  return data;
 }
 
 /*========================================================================*/
@@ -1051,7 +1065,7 @@ module_sfs(Scheme_Object *data, SFS_Info *old_info)
   Scheme_Module *m = (Scheme_Module *)data;
   Scheme_Object *e, *ex;
   SFS_Info *info;
-  int i, cnt, let_depth;
+  int i, j, cnt, let_depth;
 
   if (!old_info->for_mod) {
     if (old_info->pass)
@@ -1065,25 +1079,27 @@ module_sfs(Scheme_Object *data, SFS_Info *old_info)
 
   info = old_info;
 
-  cnt = SCHEME_VEC_SIZE(m->body);
+  cnt = SCHEME_VEC_SIZE(m->bodies[0]);
   scheme_sfs_start_sequence(info, cnt, 0);
 
   for (i = 0; i < cnt; i++) {
-    e = scheme_sfs_expr(SCHEME_VEC_ELS(m->body)[i], info, -1);
-    SCHEME_VEC_ELS(m->body)[i] = e;
+    e = scheme_sfs_expr(SCHEME_VEC_ELS(m->bodies[0])[i], info, -1);
+    SCHEME_VEC_ELS(m->bodies[0])[i] = e;
   }
 
   if (!info->pass) {
-    cnt = SCHEME_VEC_SIZE(m->et_body);
-    for (i = 0; i < cnt; i++) {
-      e = SCHEME_VEC_ELS(m->et_body)[i];
-      
-      let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
-      ex = SCHEME_VEC_ELS(e)[1];
-      
-      info = scheme_new_sfs_info(let_depth);
-      ex = scheme_sfs(ex, info, let_depth);
-      SCHEME_VEC_ELS(e)[1] = ex;
+    for (j = m->num_phases; j-- > 1; ) {
+      cnt = SCHEME_VEC_SIZE(m->bodies[j]);
+      for (i = 0; i < cnt; i++) {
+        e = SCHEME_VEC_ELS(m->bodies[j])[i];
+        
+        let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
+        ex = SCHEME_VEC_ELS(e)[1];
+        
+        info = scheme_new_sfs_info(let_depth);
+        ex = scheme_sfs(ex, info, let_depth);
+        SCHEME_VEC_ELS(e)[1] = ex;
+      }
     }
   }
 
@@ -1205,11 +1221,11 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
     expr = define_values_sfs(expr, info);
     break;
   case scheme_define_syntaxes_type:
-    expr = define_for_syntaxes_sfs(expr, info);
-    break;
-  case scheme_define_for_syntax_type:
     expr = define_syntaxes_sfs(expr, info);
     break;
+  case scheme_begin_for_syntax_type:
+    expr = begin_for_syntax_sfs(expr, info);
+    break;
   case scheme_set_bang_type:
     expr = set_sfs(expr, info);
     break;
diff --git a/src/racket/src/startup.inc b/src/racket/src/startup.inc
index 39623b781f..6f6969481a 100644
--- a/src/racket/src/startup.inc
+++ b/src/racket/src/startup.inc
@@ -8,8 +8,8 @@
 " let let* letrec"
 " parameterize"
 " define)"
-"(define-values-for-syntax(here-stx)"
-"(quote-syntax here))"
+"(begin-for-syntax "
+"(define-values(here-stx)(quote-syntax here)))"
 "(define-syntaxes(unless)"
 "(lambda(stx)"
 "(let-values(((s)(syntax->list stx)))"
diff --git a/src/racket/src/startup.rktl b/src/racket/src/startup.rktl
index 95598ea0c1..8c5b451f3d 100644
--- a/src/racket/src/startup.rktl
+++ b/src/racket/src/startup.rktl
@@ -41,8 +41,8 @@
              parameterize
              define)
 
-  (define-values-for-syntax (here-stx)
-    (quote-syntax here))
+  (begin-for-syntax 
+   (define-values (here-stx) (quote-syntax here)))
 
   (define-syntaxes (unless)
     (lambda (stx)
diff --git a/src/racket/src/stypes.h b/src/racket/src/stypes.h
index 4f8413527a..ecc7a0818f 100644
--- a/src/racket/src/stypes.h
+++ b/src/racket/src/stypes.h
@@ -20,7 +20,7 @@ enum {
 
   scheme_define_values_type,            /* 15 */
   scheme_define_syntaxes_type,          /* 16 */
-  scheme_define_for_syntax_type,        /* 17 */
+  scheme_begin_for_syntax_type,         /* 17 */
   scheme_set_bang_type,                 /* 18 */
   scheme_boxenv_type,                   /* 19 */
   scheme_begin0_sequence_type,          /* 20 */
@@ -270,6 +270,7 @@ enum {
   scheme_rt_validate_clearing,          /* 246 */
   scheme_rt_rb_node,                    /* 247 */
   scheme_rt_lightweight_cont,           /* 248 */
+  scheme_rt_export_info,                /* 249 */
 #endif
 
   _scheme_last_type_
diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c
index fd59520c95..4a81f7ed24 100644
--- a/src/racket/src/syntax.c
+++ b/src/racket/src/syntax.c
@@ -4355,8 +4355,11 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
 		result = glob_id;
 	      } else {
 		result = SCHEME_CDR(rename);
-		if (SCHEME_PAIRP(result))
+		if (SCHEME_PAIRP(result)) {
+                  if (SCHEME_INTP(SCHEME_CAR(result))) /* phase? */
+                    result = SCHEME_CDR(result);
 		  result = SCHEME_CAR(result);
+                }
 	      }
 	    } else
 	      result = glob_id;
diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c
index fe26d20705..4b7d1627b0 100644
--- a/src/racket/src/thread.c
+++ b/src/racket/src/thread.c
@@ -198,7 +198,7 @@ static void get_ready_for_GC(void);
 static void done_with_GC(void);
 #ifdef MZ_PRECISE_GC
 static void inform_GC(int master_gc, int major_gc, intptr_t pre_used, intptr_t post_used,
-                      intptr_t pre_admin, intptr_t post_admin);
+                      intptr_t pre_admin, intptr_t post_admin, intptr_t post_child_places_used);
 #endif
 
 THREAD_LOCAL_DECL(static volatile short delayed_break_ready);
@@ -988,7 +988,9 @@ static void adjust_custodian_family(void *mgr, void *skip_move)
 	      o = WEAKIFIED(((Scheme_Thread_Custodian_Hop *)o)->p);
 	      if (o)
 		GC_register_thread(o, parent);
-	    }
+	    } else if (SAME_TYPE(SCHEME_TYPE(o), scheme_place_type)) {
+              GC_register_thread(o, parent);
+            }
 	  }
 #endif
 	}
@@ -1454,6 +1456,30 @@ static Scheme_Object *extract_thread(Scheme_Object *o)
   return (Scheme_Object *)WEAKIFIED(((Scheme_Thread_Custodian_Hop *)o)->p);
 }
 
+static void pause_place(Scheme_Object *o)
+{
+#ifdef MZ_USE_PLACES
+  scheme_pause_one_place((Scheme_Place *)o);
+#endif
+}
+
+void scheme_pause_all_places()
+{
+  for_each_managed(scheme_place_type, pause_place);
+}
+
+static void resume_place(Scheme_Object *o)
+{
+#ifdef MZ_USE_PLACES
+  scheme_resume_one_place((Scheme_Place *)o);
+#endif
+}
+
+void scheme_resume_all_places()
+{
+  for_each_managed(scheme_place_type, resume_place);
+}
+
 void scheme_init_custodian_extractors()
 {
   if (!extractors) {
@@ -4196,6 +4222,13 @@ void scheme_thread_block(float sleep_time)
   if (!do_atomic)
     scheme_place_check_for_interruption();
 #endif
+
+  /* Propagate memory-use information and check for custodian-based
+     GC triggers due to child place memory use: */
+#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
+  scheme_place_check_memory_use();
+  check_scheduled_kills();
+#endif
   
   if (sleep_end > 0) {
     if (sleep_end > scheme_get_inexact_milliseconds()) {
@@ -7695,7 +7728,8 @@ static char *gc_num(char *nums, int v)
 
 static void inform_GC(int master_gc, int major_gc, 
                       intptr_t pre_used, intptr_t post_used,
-                      intptr_t pre_admin, intptr_t post_admin)
+                      intptr_t pre_admin, intptr_t post_admin,
+                      intptr_t post_child_places_used)
 {
   Scheme_Logger *logger = scheme_get_main_logger();
   if (logger) {
@@ -7731,6 +7765,11 @@ static void inform_GC(int master_gc, int major_gc,
     scheme_log_message(logger, SCHEME_LOG_DEBUG, buf, buflen, NULL);
   }
 
+#ifdef MZ_USE_PLACES
+  if (!master_gc) {
+    scheme_place_set_memory_use(post_used + post_child_places_used);
+  }
+#endif
 }
 #endif
 
diff --git a/src/racket/src/type.c b/src/racket/src/type.c
index 98f1bbb915..5d6c3700a4 100644
--- a/src/racket/src/type.c
+++ b/src/racket/src/type.c
@@ -125,7 +125,7 @@ scheme_init_type ()
 
   set_name(scheme_define_values_type, "<define-values-code>");
   set_name(scheme_define_syntaxes_type, "<define-syntaxes-code>");
-  set_name(scheme_define_for_syntax_type, "<define-for-syntax-code>");
+  set_name(scheme_begin_for_syntax_type, "<begin-for-syntax-code>");
   set_name(scheme_begin0_sequence_type, "<begin0-code>");
   set_name(scheme_splice_sequence_type, "<splicing-begin-code>");
   set_name(scheme_module_type, "<module-code>");
@@ -297,12 +297,13 @@ scheme_init_type ()
   set_name(_scheme_values_types_, "<resurrected>");
   set_name(_scheme_compiled_values_types_, "<internal>");
 
+  set_name(scheme_place_type, "<place>");
+  set_name(scheme_place_async_channel_type, "<place-half-channel>");
+  set_name(scheme_place_bi_channel_type, "<place-channel>");
+
 #ifdef MZ_GC_BACKTRACE
   set_name(scheme_rt_meta_cont, "<meta-continuation>");
 #endif
-  set_name(scheme_place_type, "<place>");
-  set_name(scheme_place_async_channel_type, "<place_async_channel>");
-  set_name(scheme_place_bi_channel_type, "<place_bidirectional_channel>");
 }
 
 Scheme_Type scheme_make_type(const char *name)
@@ -539,7 +540,7 @@ void scheme_register_traversers(void)
 
   GC_REG_TRAV(scheme_define_values_type, vector_obj);
   GC_REG_TRAV(scheme_define_syntaxes_type, vector_obj);
-  GC_REG_TRAV(scheme_define_for_syntax_type, vector_obj);
+  GC_REG_TRAV(scheme_begin_for_syntax_type, vector_obj);
   GC_REG_TRAV(scheme_varref_form_type, twoptr_obj);
   GC_REG_TRAV(scheme_apply_values_type, twoptr_obj);
   GC_REG_TRAV(scheme_boxenv_type, twoptr_obj);
@@ -548,6 +549,7 @@ void scheme_register_traversers(void)
   GC_REG_TRAV(scheme_splice_sequence_type, seq_rec);
   GC_REG_TRAV(scheme_set_bang_type, set_bang);
   GC_REG_TRAV(scheme_module_type, module_val);
+  GC_REG_TRAV(scheme_rt_export_info, exp_info_val);
   GC_REG_TRAV(scheme_require_form_type, twoptr_obj);
 
   GC_REG_TRAV(_scheme_values_types_, bad_trav);
diff --git a/src/racket/src/validate.c b/src/racket/src/validate.c
index 0c162d7dcb..d1e7ecb1db 100644
--- a/src/racket/src/validate.c
+++ b/src/racket/src/validate.c
@@ -430,7 +430,7 @@ static void do_define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
   Scheme_Object *name, *val, *base_stack_depth, *dummy;
   int sdepth;
 
-  if (!SAME_TYPE(SCHEME_TYPE(data), (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type))
+  if (!SAME_TYPE(SCHEME_TYPE(data), (for_stx ? scheme_begin_for_syntax_type : scheme_define_syntaxes_type))
       || (SCHEME_VEC_SIZE(data) < 4))
     scheme_ill_formed_code(port);
 
@@ -462,10 +462,13 @@ static void do_define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
   if (!for_stx) {
     scheme_validate_code(port, SCHEME_VEC_ELS(data)[0], sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0);
   } else {
-    /* Make a fake `define-values' to check with respect to the exp-time stack */
-    val = scheme_clone_vector(data, 3, 1);
-    SCHEME_VEC_ELS(val)[0] = SCHEME_VEC_ELS(data)[0];
-    scheme_validate_code(port, val, sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0);
+    val = SCHEME_VEC_ELS(data)[0];
+    while (SCHEME_PAIRP(val)) {
+      scheme_validate_code(port, SCHEME_CAR(val), sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0);
+      val = SCHEME_CDR(val);
+    }
+    if (!SCHEME_NULLP(val))
+      scheme_ill_formed_code(port);
   }
 }
 
@@ -481,13 +484,13 @@ static void define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
                               num_toplevels, num_stxes, num_lifts, tl_use_map, 0);
 }
 
-static void define_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port, 
-					 char *stack, Validate_TLS tls,
-                                         int depth, int letlimit, int delta, 
-					 int num_toplevels, int num_stxes, int num_lifts, 
-                                         void *tl_use_map, int result_ignored,
-                                         struct Validate_Clearing *vc, int tailpos,
-                                         Scheme_Hash_Tree *procs)
+static void begin_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port, 
+                                        char *stack, Validate_TLS tls,
+                                        int depth, int letlimit, int delta, 
+                                        int num_toplevels, int num_stxes, int num_lifts, 
+                                        void *tl_use_map, int result_ignored,
+                                        struct Validate_Clearing *vc, int tailpos,
+                                        Scheme_Hash_Tree *procs)
 {
   do_define_syntaxes_validate(data, port, stack, tls, depth, letlimit, delta, 
                               num_toplevels, num_stxes, num_lifts, tl_use_map, 1);
@@ -849,7 +852,7 @@ static void module_validate(Scheme_Object *data, Mz_CPort *port,
                             Scheme_Hash_Tree *procs)
 {
   Scheme_Module *m;
-  int i, cnt, let_depth;
+  int i, j, cnt, let_depth;
   Resolve_Prefix *rp;
   Scheme_Object *e;
 
@@ -859,23 +862,25 @@ static void module_validate(Scheme_Object *data, Mz_CPort *port,
   if (!SCHEME_MODNAMEP(m->modname))
     scheme_ill_formed_code(port);
 
-  scheme_validate_code(port, m->body, m->max_let_depth,
+  scheme_validate_code(port, m->bodies[0], m->max_let_depth,
                        m->prefix->num_toplevels, m->prefix->num_stxes, m->prefix->num_lifts,
                        NULL,
                        1);
   
   /* validate exp-time code */
-  cnt = SCHEME_VEC_SIZE(m->et_body);
-  for (i = 0; i < cnt; i++) {
-    e = SCHEME_VEC_ELS(m->et_body)[i];
+  for (j = m->num_phases; j-- > 1; ) {
+    cnt = SCHEME_VEC_SIZE(m->bodies[j]);
+    for (i = 0; i < cnt; i++) {
+      e = SCHEME_VEC_ELS(m->bodies[j])[i];
       
-    let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
-    rp = (Resolve_Prefix *)SCHEME_VEC_ELS(e)[3];
-    e = SCHEME_VEC_ELS(e)[1];
+      let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
+      rp = (Resolve_Prefix *)SCHEME_VEC_ELS(e)[3];
+      e = SCHEME_VEC_ELS(e)[1];
       
-    scheme_validate_code(port, e, let_depth,
-                         rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL,
-                         0);
+      scheme_validate_code(port, e, let_depth,
+                           rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL,
+                           0);
+    }
   }
 }
 
@@ -1442,11 +1447,11 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
                              num_toplevels, num_stxes, num_lifts, tl_use_map, 
                              result_ignored, vc, tailpos, procs);
     break;
-  case scheme_define_for_syntax_type:
+  case scheme_begin_for_syntax_type:
     no_flo(need_flonum, port);
-    define_for_syntaxes_validate(expr, port, stack, tls, depth, letlimit, delta, 
-                                 num_toplevels, num_stxes, num_lifts, tl_use_map, 
-                                 result_ignored, vc, tailpos, procs);
+    begin_for_syntaxes_validate(expr, port, stack, tls, depth, letlimit, delta, 
+                                num_toplevels, num_stxes, num_lifts, tl_use_map, 
+                                result_ignored, vc, tailpos, procs);
     break;
   case scheme_set_bang_type:
     no_flo(need_flonum, port);