diff --git a/collects/deinprogramm/deinprogramm-langs.rkt b/collects/deinprogramm/deinprogramm-langs.rkt
index ccdf1b64b7..8759c82758 100644
--- a/collects/deinprogramm/deinprogramm-langs.rkt
+++ b/collects/deinprogramm/deinprogramm-langs.rkt
@@ -1246,10 +1246,12 @@
       ;;  test coverage
       ;;
       
+      ;; WARNING: much code copied from "collects/lang/htdp-langs.rkt"
+      
       (define test-coverage-enabled (make-parameter #t))
       (define current-test-coverage-info (make-thread-cell #f))
       
-      (define (initialize-test-coverage-point key expr)
+      (define (initialize-test-coverage-point expr)
         (unless (thread-cell-ref current-test-coverage-info)
           (let ([ht (make-hasheq)])
             (thread-cell-set! current-test-coverage-info ht)
@@ -1272,15 +1274,19 @@
                        (send rep set-test-coverage-info ht on-sd off-sd #f)))))))))
         (let ([ht (thread-cell-ref current-test-coverage-info)])
           (when ht
-            (hash-set! ht key (mcons #f expr)))))
+            (hash-set! ht expr #;(box #f) (mcons #f #f)))))
       
-      (define (test-covered key)
-        (let ([ht (thread-cell-ref current-test-coverage-info)])
-          (and ht
-               (let ([v (hash-ref ht key)])
-                 (and v
-                      (with-syntax ([v v])
-                        #'(set-mcar! v #t)))))))
+      (define (test-covered expr)
+        (let* ([ht (or (thread-cell-ref current-test-coverage-info)
+                       (error 'deinprogramm-langs
+                              "internal-error: no test-coverage table"))]
+               [v (hash-ref ht expr
+                    (lambda ()
+                      (error 'deinprogramm-langs
+                             "internal-error: expression not found: ~.s"
+                             expr)))])
+          #; (lambda () (set-box! v #t))
+          (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t))))
       
       (define-values/invoke-unit et:stacktrace@
         (import et:stacktrace-imports^) (export (prefix et: et:stacktrace^)))
diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt
index c38d787b9c..d06a46621a 100644
--- a/collects/drracket/private/debug.rkt
+++ b/collects/drracket/private/debug.rkt
@@ -925,7 +925,7 @@ profile todo:
   
   (define current-test-coverage-info (make-thread-cell #f))
   
-  (define (initialize-test-coverage-point key expr)
+  (define (initialize-test-coverage-point expr)
     (unless (hash? (thread-cell-ref current-test-coverage-info))
       (let ([rep (drracket:rep:current-rep)])
         (when rep
@@ -938,14 +938,14 @@ profile todo:
       (when (hash? ht)
         ;; if rep isn't around, we don't do test coverage...
         ;; this can happen when check syntax expands, for example
-        (hash-set! ht key (mcons #f expr)))))
+        (hash-set! ht expr #;(box #f) (mcons #f #f)))))
   
-  (define (test-covered key)
+  (define (test-covered expr)
     (let ([ht (thread-cell-ref current-test-coverage-info)])
       (and (hash? ht) ;; as in the `when' test in `initialize-test-coverage-point'
-           (let ([v (hash-ref ht key #f)])
-             (and v
-                  (λ () (set-mcar! v #t)))))))
+           (let ([v (hash-ref ht expr #f)])
+             ;; (and v (λ () (set-box! v #t)))
+             (and v (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t)))))))
   
   (define test-coverage-interactions-text<%>
     (interface ()
@@ -1075,7 +1075,6 @@ profile todo:
                [locked-ht (make-hasheq)]
                [already-frozen-ht (make-hasheq)]
                [actions-ht (make-hash)]
-               [on/syntaxes (hash-map ht (λ (_ pr) pr))]
                
                ;; can-annotate : (listof (list boolean srcloc))
                ;; boolean is #t => code was run
@@ -1083,17 +1082,17 @@ profile todo:
                ;; remove those that cannot be annotated
                [can-annotate
                 (filter values
-                        (map (λ (pr)
-                               (let ([stx (mcdr pr)])
-                                 (and (syntax? stx)
-                                      (let ([src (syntax-source stx)]
-                                            [pos (syntax-position stx)]
-                                            [span (syntax-span stx)])
-                                        (and pos
-                                             span
-                                             (send (get-defs) port-name-matches? src)
-                                             (list (mcar pr) (make-srcloc (get-defs) #f #f pos span)))))))
-                             on/syntaxes))]
+                        (hash-map ht
+                          (λ (stx covered?)
+                            (and (syntax? stx)
+                                 (let ([src (syntax-source stx)]
+                                       [pos (syntax-position stx)]
+                                       [span (syntax-span stx)])
+                                   (and pos
+                                        span
+                                        (send (get-defs) port-name-matches? src)
+                                        (list (mcar covered?)
+                                              (make-srcloc (get-defs) #f #f pos span))))))))]
                
                ;; filtered : (listof (list boolean srcloc))
                ;; remove redundant expressions
diff --git a/collects/errortrace/errortrace-lib.rkt b/collects/errortrace/errortrace-lib.rkt
index 43fd6a364e..d7a11da398 100644
--- a/collects/errortrace/errortrace-lib.rkt
+++ b/collects/errortrace/errortrace-lib.rkt
@@ -66,7 +66,7 @@
 ;; expressions with test suite coverage information.  Returning the
 ;; first argument means no tests coverage information is collected.
 
-;; test-coverage-point : syntax syntax -> (values syntax info)
+;; test-coverage-point : syntax syntax integer -> (values syntax info)
 ;; sets a test coverage point for a single expression
 (define (test-coverage-point body expr phase)
   (if (and (test-coverage-enabled) (zero? phase))
@@ -240,10 +240,8 @@
         (with-syntax ([key (datum->syntax #f key (quote-syntax here))]
                       [expr expr]
                       [register-executed-once register-executed-once]);<- 3D!
-          (syntax
-           (begin
-             (register-executed-once 'key)
-             expr))))
+          #'(begin (register-executed-once 'key)
+                   expr)))
       expr))
 
 (define (get-execute-counts)
diff --git a/collects/errortrace/scribblings/errortrace.scrbl b/collects/errortrace/scribblings/errortrace.scrbl
index b7ee22db0e..9567e8d832 100644
--- a/collects/errortrace/scribblings/errortrace.scrbl
+++ b/collects/errortrace/scribblings/errortrace.scrbl
@@ -418,27 +418,31 @@ be wrapped.}
 Determines if the test coverage annotation is inserted into the code.
 This parameter controls how compilation happens---it does not affect the
 dynamic behavior of the already compiled code. If the parameter is set,
-calls to @schemein[test-covered] are inserted into the code (and
+code generated by @schemein[test-covered] are inserted into the code (and
 @schemein[initialize-test-coverage-point] is called during compilation).
-If not, no calls to test-covered are inserted.}
+If not, no calls to @scheme[test-covered] code are inserted.}
 
-@defproc[(test-covered (key any/c)) (or/c (-> void?) syntax? #f)]{
-This is called during compilation of the program with a key value once
- for each point with the key for that program point that was passed to
+@defproc[(test-covered (stx any/c)) (or/c syntax? (-> void?) #f)]{
+This is called during compilation of the program with an expression for
+each point in the program that was passed to
 @schemein[initialize-test-coverage-point].
 
-If the result is @scheme[#f], this program point is not
-instrumented. If the result is syntax, it is inserted into the code,
-and if it is a thunk, the thunk is inserted into the code in an
-application. In either case, the syntax or the thunk should register
-that the relevant point was covered.}
+If the result is @scheme[#f], this program point is not instrumented. If
+the result is syntax, it is inserted into the code, and if it is a
+thunk, the thunk is inserted into the code in an application (using the
+thunk directly, as a 3D value). In either case, the syntax or the thunk
+should register that the relevant point was covered.
 
-@defproc[(initialize-test-coverage-point (key any/c) (stx any/c)) void?]{
+Note: using a thunk tends to be slow.  Current uses in the Racket code
+will create a mutable pair in @scheme[initialize-test-coverage-point],
+and @scheme[test-covered] returns syntax that will set its mcar.  (This
+makes the resulting overhead about 3 times smaller.)}
+
+@defproc[(initialize-test-coverage-point (stx any/c)) void?]{
 
 During compilation of the program, this function is called with each
-sub-expression of the program. The first argument is a special key
-used to identify this program point. The second argument is the
-syntax of this program point.}
+sub-expression of the program. The argument is the syntax of this program
+point, which is usually used as a key to identify this program point.}
 
 @defthing[profile-key any/c]{
 
diff --git a/collects/errortrace/stacktrace.rkt b/collects/errortrace/stacktrace.rkt
index 2807ba70c4..6876aeeb0b 100644
--- a/collects/errortrace/stacktrace.rkt
+++ b/collects/errortrace/stacktrace.rkt
@@ -10,7 +10,7 @@
   (with-mark
    
    test-coverage-enabled
-   test-covered   
+   test-covered
    initialize-test-coverage-point
    
    profile-key
@@ -73,33 +73,28 @@
   
   
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;; Test case coverage instrumenter
+  ;; Test case coverage instrumenter
  
-       ;; The next procedure is called by `annotate' and `annotate-top' to wrap
-       ;; expressions with test suite coverage information.  Returning the
-       ;; first argument means no tests coverage information is collected.
+  ;; The next procedure is called by `annotate' and `annotate-top' to wrap
+  ;; expressions with test suite coverage information.  Returning the
+  ;; first argument means no tests coverage information is collected.
  
-       ;; test-coverage-point : syntax syntax phase -> syntax
-       ;; sets a test coverage point for a single expression
-       (define (test-coverage-point body expr phase)
-         (if (and (test-coverage-enabled)
-                  (zero? phase)
-                  (syntax-position expr))
-             (let* ([key (gensym 'test-coverage-point)])
-               (initialize-test-coverage-point key expr)
-               (let ([thunk (test-covered key)])
-                 (cond
-                   [(procedure? thunk)
-                    (with-syntax ([body body]
-                                  [thunk thunk])
-                      #'(begin (#%plain-app thunk) body))]
-                   [(syntax? thunk)
-                    (with-syntax ([body body]
-                                  [thunk thunk])
-                      #'(begin thunk body))]
-                   [else
-                    body])))
-             body))
+  ;; test-coverage-point : syntax syntax phase -> syntax
+  ;; sets a test coverage point for a single expression
+  (define (test-coverage-point body expr phase)
+    (if (and (test-coverage-enabled)
+             (zero? phase)
+             (syntax-position expr))
+      (begin (initialize-test-coverage-point expr)
+             (let ([thunk (test-covered expr)])
+               (cond [(procedure? thunk)
+                      (with-syntax ([body body] [thunk thunk])
+                        #'(begin (#%plain-app thunk) body))]
+                     [(syntax? thunk)
+                      (with-syntax ([body body] [thunk thunk])
+                        #'(begin thunk body))]
+                     [else body])))
+      body))
 
 
 
@@ -227,39 +222,32 @@
     (let ([p (syntax-property orig 'method-arity-error)]
           [p2 (syntax-property orig 'inferred-name)])
       (let ([new (if p
-                     (syntax-property new 'method-arity-error p)
-                     new)])
+                   (syntax-property new 'method-arity-error p)
+                   new)])
         (if p2
             (syntax-property new 'inferred-name p2)
             new))))
   
   (define (annotate-let expr phase varss-stx rhss-stx bodys-stx)
     (let ([varss (syntax->list varss-stx)]
-          [rhss (syntax->list rhss-stx)]
+          [rhss  (syntax->list rhss-stx)]
           [bodys (syntax->list bodys-stx)])
       (let ([rhsl (map
                    (lambda (vars rhs)
                      (annotate-named
-                      (syntax-case vars ()
-                        [(id)
-                         (syntax id)]
-                        [_else #f])
+                      (syntax-case vars () [(id) (syntax id)] [_else #f])
                       rhs
                       phase))
                    varss
                    rhss)]
-            [bodyl (map
-                    (lambda (body)
-                      (annotate body phase))
-                    bodys)])
+            [bodyl (map (lambda (body) (annotate body phase))
+                        bodys)])
         (rebuild expr (append (map cons bodys bodyl)
                               (map cons rhss rhsl))))))
   
   (define (annotate-seq expr bodys-stx annotate phase)
     (let* ([bodys (syntax->list bodys-stx)]
-           [bodyl (map (lambda (b)
-                         (annotate b phase))
-                       bodys)])
+           [bodyl (map (lambda (b) (annotate b phase)) bodys)])
       (rebuild expr (map cons bodys bodyl))))
   
   (define orig-inspector (current-code-inspector))
@@ -268,45 +256,30 @@
     (syntax-recertify new orig orig-inspector #f))
   
   (define (rebuild expr replacements)
-    (let loop ([expr expr]
-               [same-k (lambda () expr)]
-               [diff-k (lambda (x) x)])
+    (let loop ([expr expr] [same-k (lambda () expr)] [diff-k (lambda (x) x)])
       (let ([a (assq expr replacements)])
-        (if a
-            (diff-k (cdr a))
-            (cond
-              [(pair? expr) (loop (car expr)
-                                  (lambda ()
-                                    (loop (cdr expr)
-                                          same-k
-                                          (lambda (y)
-                                            (diff-k (cons (car expr) y)))))
-                                  (lambda (x)
-                                    (loop (cdr expr)
-                                          (lambda ()
-                                            (diff-k (cons x (cdr expr))))
-                                          (lambda (y)
-                                            (diff-k (cons x y))))))]
-              [(vector? expr)
-               (loop (vector->list expr)
-                     same-k
-                     (lambda (x) (diff-k (list->vector x))))]
-              [(box? expr) (loop (unbox expr)
-                                 same-k
-                                 (lambda (x)
-                                   (diff-k (box x))))]
-              [(syntax? expr) (if (identifier? expr)
-                                  (same-k)
-                                  (loop (syntax-e expr)
-                                        same-k
-                                        (lambda (x)
-                                          (diff-k
-                                           (datum->syntax
-                                            expr
-                                            x
-                                            expr
-                                            expr)))))]
-              [else (same-k)])))))
+        (cond
+          [a (diff-k (cdr a))]
+          [(pair? expr)
+           (loop (car expr)
+                 (lambda ()
+                   (loop (cdr expr) same-k
+                         (lambda (y) (diff-k (cons (car expr) y)))))
+                 (lambda (x)
+                   (loop (cdr expr)
+                         (lambda () (diff-k (cons x (cdr expr))))
+                         (lambda (y) (diff-k (cons x y))))))]
+          [(vector? expr)
+           (loop (vector->list expr) same-k
+                 (lambda (x) (diff-k (list->vector x))))]
+          [(box? expr)
+           (loop (unbox expr) same-k (lambda (x) (diff-k (box x))))]
+          [(syntax? expr)
+           (if (identifier? expr)
+             (same-k)
+             (loop (syntax-e expr) same-k
+                   (lambda (x) (diff-k (datum->syntax expr x expr expr)))))]
+          [else (same-k)]))))
   
   (define (append-rebuild expr end)
     (cond
diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt
index 6c11906e74..a5ba78d5ae 100644
--- a/collects/lang/htdp-langs.rkt
+++ b/collects/lang/htdp-langs.rkt
@@ -1076,7 +1076,7 @@
       (define test-coverage-enabled (make-parameter #t))
       (define current-test-coverage-info (make-thread-cell #f))
       
-      (define (initialize-test-coverage-point key expr)
+      (define (initialize-test-coverage-point expr)
         (unless (thread-cell-ref current-test-coverage-info)
           (let ([ht (make-hasheq)])
             (thread-cell-set! current-test-coverage-info ht)
@@ -1144,16 +1144,19 @@
                        (send rep set-test-coverage-info ht on-sd off-sd #f)))))))))
         (let ([ht (thread-cell-ref current-test-coverage-info)])
           (when ht
-            (hash-set! ht key (mcons #f expr)))))
+            (hash-set! ht expr #;(box #f) (mcons #f #f)))))
       
-      (define (test-covered key)
-        (let* ([ht (thread-cell-ref current-test-coverage-info)]
-               [v (and ht (hash-ref ht key #f))])
-          (with-syntax ([v v])
-            #'(set-mcar! v #t))
-          #;
-          (and v
-               (λ () (set-mcar! v #t)))))
+      (define (test-covered expr)
+        (let* ([ht (or (thread-cell-ref current-test-coverage-info)
+                       (error 'htdp-langs
+                              "internal-error: no test-coverage table"))]
+               [v (hash-ref ht expr
+                    (lambda ()
+                      (error 'htdp-langs
+                             "internal-error: expression not found: ~.s"
+                             expr)))])
+          #; (lambda () (set-box! v #t))
+          (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t))))
       
       (define-values/invoke-unit et:stacktrace@
         (import et:stacktrace-imports^) (export (prefix et: et:stacktrace^)))
diff --git a/collects/racket/match/compiler.rkt b/collects/racket/match/compiler.rkt
index 9f422e0794..533d877405 100644
--- a/collects/racket/match/compiler.rkt
+++ b/collects/racket/match/compiler.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require (for-template scheme/base "runtime.rkt" scheme/stxparam)
+(require (for-template scheme/base "runtime.rkt" scheme/stxparam racket/unsafe/ops)
          syntax/boundmap
          syntax/stx
          "patterns.rkt"
@@ -60,12 +60,13 @@
       #`[(pred #,x) (let ([tmps (accs #,x)] ...) body)]))
   (cond
     [(eq? 'box k)
-     (compile-con-pat (list #'unbox) #'box? (compose list Box-p))]
+     (compile-con-pat (list #'unsafe-unbox*) #'box? (compose list Box-p))]
     [(eq? 'pair k)
-     (compile-con-pat (list #'car #'cdr) #'pair?
+     (compile-con-pat (list #'unsafe-car #'unsafe-cdr) #'pair?
                       (lambda (p) (list (Pair-a p) (Pair-d p))))]
     [(eq? 'mpair k)
-     (compile-con-pat (list #'mcar #'mcdr) #'mpair?
+     ; XXX These should be unsafe-mcar* when mpairs have chaperones
+     (compile-con-pat (list #'unsafe-mcar #'unsafe-mcdr) #'mpair?
                       (lambda (p) (list (MPair-a p) (MPair-d p))))]
     [(eq? 'string k)  (constant-pat #'string?)]
     [(eq? 'number k)  (constant-pat #'number?)]
@@ -104,10 +105,10 @@
                                    esc)]
                                  [(n ...) ns])
                      #`[(#,arity)
-                        (let ([tmps (vector-ref #,x n)] ...)
+                        (let ([tmps (unsafe-vector*-ref #,x n)] ...)
                           body)]))))])])
        #`[(vector? #,x)
-          (case (vector-length #,x)
+          (case (unsafe-vector*-length #,x)
             clauses ...
             [else (#,esc)])])]
     ;; it's a structure
@@ -115,6 +116,9 @@
      ;; all the rows are structures with the same predicate
      (let* ([s (Row-first-pat (car rows))]
             [accs (Struct-accessors s)]
+            [accs (if (Struct-complete? s)
+                      (build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct*-ref x #,i))))
+                      accs)]
             [pred (Struct-pred s)])
        (compile-con-pat accs pred Struct-ps))]
     [else (error 'match-compile "bad key: ~a" k)]))
diff --git a/collects/racket/match/parse-helper.rkt b/collects/racket/match/parse-helper.rkt
index 3d45825914..5b7f3bfa79 100644
--- a/collects/racket/match/parse-helper.rkt
+++ b/collects/racket/match/parse-helper.rkt
@@ -85,43 +85,47 @@
         (let ([super (list-ref (extract-struct-info (syntax-local-value
                                                      struct-name))
                                5)])
-          (cond [(equal? super #t) '()] ;; no super type exists
-                [(equal? super #f) '()] ;; super type is unknown
-                [else (cons super (get-lineage super))])))
+          (cond [(equal? super #t) (values #t '())] ;; no super type exists
+                [(equal? super #f) (values #f '())] ;; super type is unknown
+                [else 
+                 (let-values ([(complete? lineage) (get-lineage super)])
+                   (values complete?
+                           (cons super lineage)))])))
       (unless pred
         (raise-syntax-error 'match (format "structure ~a does not have an associated predicate"
                                            (syntax->datum struct-name))
                             stx struct-name))
-      (let* (;; the accessors come in reverse order
-             [acc (reverse acc)]
-             ;; remove the first element, if it's #f
-             [acc (cond [(null? acc) acc]
-                        [(not (car acc)) (cdr acc)]
-                        [else acc])])
-        (make-Struct pred
-                     (syntax-property 
-                      pred 
-                      'disappeared-use (list struct-name))
-                     (get-lineage (cert struct-name))
-                     acc
-                     (cond [(eq? '_ (syntax-e pats))                            
-                            (map make-Dummy acc)]
-                           [(syntax->list pats)
-                            =>
-                            (lambda (ps)
-                              (unless (= (length ps) (length acc))
-                                (raise-syntax-error
-                                 'match
-                                 (format "~a structure ~a: expected ~a but got ~a"
-                                         "wrong number for fields for"
-                                         (syntax->datum struct-name) (length acc)
-                                         (length ps))
-                                 stx pats))
-                              (map parse ps))]
-                           [else (raise-syntax-error
-                                  'match
-                                  "improper syntax for struct pattern"
-                                  stx pats)]))))))
+      (let-values ([(complete? lineage) (get-lineage (cert struct-name))])
+        (let* (;; the accessors come in reverse order
+               [acc (reverse acc)]
+               ;; remove the first element, if it's #f
+               [acc (cond [(null? acc) acc]
+                          [(not (car acc)) (cdr acc)]
+                          [else acc])])
+          (make-Struct pred
+                       (syntax-property 
+                        pred 
+                        'disappeared-use (list struct-name))
+                       lineage complete?
+                       acc
+                       (cond [(eq? '_ (syntax-e pats))                            
+                              (map make-Dummy acc)]
+                             [(syntax->list pats)
+                              =>
+                              (lambda (ps)
+                                (unless (= (length ps) (length acc))
+                                  (raise-syntax-error
+                                   'match
+                                   (format "~a structure ~a: expected ~a but got ~a"
+                                           "wrong number for fields for"
+                                           (syntax->datum struct-name) (length acc)
+                                           (length ps))
+                                   stx pats))
+                                (map parse ps))]
+                             [else (raise-syntax-error
+                                    'match
+                                    "improper syntax for struct pattern"
+                                    stx pats)])))))))
 
 (define (trans-match pred transformer pat)
   (make-And (list (make-Pred pred) (make-App transformer pat))))
diff --git a/collects/racket/match/patterns.rkt b/collects/racket/match/patterns.rkt
index 9ba024c964..0b562ff57a 100644
--- a/collects/racket/match/patterns.rkt
+++ b/collects/racket/match/patterns.rkt
@@ -55,9 +55,10 @@
 
 ;; pred is an identifier
 ;; super is an identifier, or #f
+;; complete? is a boolean
 ;; accessors is a listof identifiers (NB in reverse order from the struct info)
 ;; ps is a listof patterns
-(define-struct (Struct CPat) (id pred super accessors ps) #:transparent)
+(define-struct (Struct CPat) (id pred super complete? accessors ps) #:transparent)
 
 ;; both fields are lists of pats
 (define-struct (HashTable CPat) (key-pats val-pats) #:transparent)
diff --git a/collects/racket/private/sandbox-coverage.rkt b/collects/racket/private/sandbox-coverage.rkt
index 6b3e891ae4..9c121ecd25 100644
--- a/collects/racket/private/sandbox-coverage.rkt
+++ b/collects/racket/private/sandbox-coverage.rkt
@@ -1,70 +1,73 @@
 ;; This file is is used in the context of sandboxed code, it uses the
 ;; stacktrace interface from errortrace to find uncovered expressions.
-(module sandbox-coverage mzscheme
-  (require errortrace/stacktrace mzlib/unit mzlib/list)
+#lang racket/base
+(require errortrace/stacktrace racket/unit (for-template racket/base))
 
-  ;; Test coverage run-time support
-  (define test-coverage-enabled (make-parameter #t))
-  (define test-coverage-info (make-hash-table))
-  (define (initialize-test-coverage-point key expr)
-    (hash-table-put! test-coverage-info key (mcons expr #f)))
-  (define (test-covered key)
-    (let ([mpair (hash-table-get test-coverage-info key)])
-      (λ () (set-mcdr! mpair #t))))
+;; Test coverage run-time support
+(define test-coverage-enabled (make-parameter #t))
+(define test-coverage-info (make-hasheq))
+(define (initialize-test-coverage-point expr)
+  (hash-set! test-coverage-info expr (mcons #f #f)))
+(define (test-covered expr)
+  (let ([v (hash-ref test-coverage-info expr
+                     (lambda ()
+                       (error 'sandbox-coverage
+                              "internal error: no info for ~.s" expr)))])
+    (and v (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t)))))
 
-  (define (get-uncovered-expressions)
-    (let* ([xs (hash-table-map test-coverage-info (lambda (k v) 
-                                                    (cons (mcar v) (mcdr v))))]
-           [xs (filter (lambda (x) (syntax-position (car x))) xs)]
-           [xs (sort xs (lambda (x1 x2)
-                          (let ([p1 (syntax-position (car x1))]
-                                [p2 (syntax-position (car x2))])
-                            (or (< p1 p2) ; earlier first
-                                (and (= p1 p2)
-                                     (> (syntax-span (car x1)) ; wider first
-                                        (syntax-span (car x2))))))))]
-           [xs (reverse xs)])
-      (if (null? xs)
-        xs
-        (let loop ([xs (cdr xs)] [r (list (car xs))])
-          (if (null? xs)
-            (map car (filter (lambda (x) (not (cdr x))) r))
-            (loop (cdr xs)
-                  (cond [(not (and (= (syntax-position (caar xs))
-                                      (syntax-position (caar r)))
-                                   (= (syntax-span (caar xs))
-                                      (syntax-span (caar r)))))
-                         (cons (car xs) r)]
-                        [(cdar r) r]
-                        [else (cons (car xs) (cdr r))])))))))
+(define (get-uncovered-expressions)
+  (let* ([xs (hash-map test-coverage-info
+                       (lambda (k v) (cons k (mcar v))))]
+         [xs (filter (lambda (x) (syntax-position (car x))) xs)]
+         [xs (sort xs (lambda (x1 x2)
+                        (let ([p1 (syntax-position (car x1))]
+                              [p2 (syntax-position (car x2))])
+                          (or (< p1 p2) ; earlier first
+                              (and (= p1 p2)
+                                   (> (syntax-span (car x1)) ; wider first
+                                      (syntax-span (car x2))))))))]
+         [xs (reverse xs)])
+    (if (null? xs)
+      xs
+      (let loop ([xs (cdr xs)] [r (list (car xs))])
+        (if (null? xs)
+          (map car (filter (lambda (x) (not (cdr x))) r))
+          (loop (cdr xs)
+                (cond [(not (and (= (syntax-position (caar xs))
+                                    (syntax-position (caar r)))
+                                 (= (syntax-span (caar xs))
+                                    (syntax-span (caar r)))))
+                       (cons (car xs) r)]
+                      [(cdar r) r]
+                      [else (cons (car xs) (cdr r))])))))))
 
-  (provide get-uncovered-expressions)
+(provide get-uncovered-expressions)
 
-  ;; no profiling
-  (define profile-key #f)
-  (define profiling-enabled (lambda () #f))
-  (define initialize-profile-point void)
-  (define register-profile-start void)
-  (define register-profile-done void)
-  ;; no marks
-  (define (with-mark mark expr) expr)
+;; no profiling
+(define profile-key #f)
+(define profiling-enabled (lambda () #f))
+(define initialize-profile-point void)
+(define register-profile-start void)
+(define register-profile-done void)
+;; no marks
+(define (with-mark mark expr) expr)
 
-  (define-values/invoke-unit/infer stacktrace@)
+(define-values/invoke-unit/infer stacktrace@)
 
-  (define errortrace-compile-handler
-    (let ([orig (current-compile)]
-          [ns (current-namespace)])
-      (lambda (e immediate-eval?)
-        (orig (if (and (eq? ns (current-namespace))
-                       (not (compiled-expression?
-                             (if (syntax? e) (syntax-e e) e))))
-                (annotate-top
-                 (expand-syntax (if (syntax? e)
-                                  e
-                                  (namespace-syntax-introduce
-                                   (datum->syntax-object #f e))))
-                 (namespace-base-phase))
-                e)
-              immediate-eval?))))
+(define errortrace-compile-handler
+  (let ([orig (current-compile)]
+        [ns (current-namespace)])
+    (lambda (e immediate-eval?)
+      (orig (if (and (eq? ns (current-namespace))
+                     (not (compiled-expression?
+                           (if (syntax? e) (syntax-e e) e))))
+              (annotate-top
+               (expand-syntax (if (syntax? e)
+                                e
+                                (namespace-syntax-introduce
+                                 (datum->syntax #f e))))
+               (namespace-base-phase))
+              e)
+            immediate-eval?))))
 
-  (current-compile errortrace-compile-handler))
+(current-compile errortrace-compile-handler)
diff --git a/collects/tests/match/plt-match-tests.rkt b/collects/tests/match/plt-match-tests.rkt
index a8b9b14657..ffd23cd20a 100644
--- a/collects/tests/match/plt-match-tests.rkt
+++ b/collects/tests/match/plt-match-tests.rkt
@@ -179,6 +179,18 @@
                     (else #f)))
                 (check-true (origin? (make-point 0 0)))
                 (check-false (origin? (make-point 1 1)))))
+   ; This test ensures that the unsafe struct optimization is correct
+   (test-case "struct patterns (with opaque parent)"
+              (let ()
+                (define-struct opq (any))
+                (parameterize ([current-inspector (make-sibling-inspector)])
+                  (define-struct point (x y) #:super struct:opq)
+                  (define (origin? pt)
+                    (match pt
+                      ((struct point (0 0)) #t)
+                      (else #f)))
+                  (check-true (origin? (make-point 'a 0 0)))
+                  (check-false (origin? (make-point 'a 1 1))))))
    ))
 
 (define nonlinear-tests
diff --git a/collects/web-server/scribblings/tutorial/continue.scrbl b/collects/web-server/scribblings/tutorial/continue.scrbl
index 240ba353f9..d77cc7c521 100644
--- a/collects/web-server/scribblings/tutorial/continue.scrbl
+++ b/collects/web-server/scribblings/tutorial/continue.scrbl
@@ -62,9 +62,9 @@ By the end of this tutorial, we'll have a simple blogging application.
 We start by considering our data definitions.  We want to represent a
 list of posts.  Let's say that a post is:
 
-@racketblock[(define-struct post (title body))]
+@racketblock[(struct post (title body))]
 
-@(defstruct post ([title string?] [body string?]))
+@(defstruct* post ([title string?] [body string?]))
 
 @bold{Exercise.} Make a few examples of posts.
 
@@ -75,8 +75,8 @@ A blog, then, will be a list of posts:
 As a very simple example of a blog:
 
 @racketblock[
-(define BLOG (list (make-post "First Post!"
-                              "Hey, this is my first post!")))
+(define BLOG (list (post "First Post!"
+                         "Hey, this is my first post!")))
 ]
 
 Now that we have a sample blog structure, let's get our web
@@ -172,7 +172,7 @@ an @racket[html-response] representing that content.
 As an example, we want:
 
 @racketblock[
-    (render-post (make-post "First post!" "This is a first post."))
+    (render-post (post "First post!" "This is a first post."))
 ]
 
 to produce:
@@ -229,8 +229,8 @@ should produce:
 While
 
 @racketblock[
-(render-posts (list (make-post "Post 1" "Body 1")
-                    (make-post "Post 2" "Body 2")))
+(render-posts (list (post "Post 1" "Body 1")
+                    (post "Post 2" "Body 2")))
 ]
 
 should produce:
@@ -441,9 +441,9 @@ Earlier, we had said that a @racket[blog] was a list of @racket[post]s,
 but because we want to allow the blog to be changed, let's revisit our
 definition so that a blog is a mutable structure:
 
-@racketblock[(define-struct blog (posts) #:mutable)]
+@racketblock[(struct blog (posts) #:mutable)]
 
-@defstruct[blog ([posts (listof post?)])]
+@defstruct*[blog ([posts (listof post?)])]
 
 Mutable structures provide functions to change the fields of a
 structure; in this case, we now have a structure mutator called
@@ -484,7 +484,7 @@ the same blog.
 Next, let's extend the application so that each post can hold a list
 of comments.  We refine the data definition of a blog to be:
 
-@defstruct[post ([title string?] [body string?] [comments (listof string?)]) #:mutable]
+@defstruct*[post ([title string?] [body string?] [comments (listof string?)]) #:mutable]
 
 @bold{Exercise.} Write the updated data structure definition for posts.  Make
 sure to make the structure mutable, since we intend to add comments to
@@ -504,7 +504,7 @@ comments in an itemized list.
 
 @bold{Exercise.} Because we've extended a post to include comments, other
 post-manipulating parts of the application may need to be adjusted,
-such as uses of @racket[make-post].  Identify and fix any other part of the
+such as uses of @racket[post].  Identify and fix any other part of the
 application that needs to accommodate the post's new structure.
 
 @centerline{------------}
@@ -736,8 +736,8 @@ between the model of our blog, and the web application that uses that
 model.  Let's isolate the model: it's all the stuff near the top:
 
 @racketblock[
-    (define-struct blog (posts) #:mutable)
-    (define-struct post (title body comments) #:mutable)
+    (struct blog (posts) #:mutable)
+    (struct post (title body comments) #:mutable)
     (define BLOG ...)
     (define (blog-insert-post! ...) ...)
     (define (post-insert-comment! ...) ...)
@@ -794,7 +794,7 @@ started running---which is exactly what we want when restoring the blog data fro
 Our blog structure definition now looks like:
 
 @racketblock[
-    (define-struct blog (posts) #:mutable #:prefab)
+    (struct blog (posts) #:mutable #:prefab)
 ]
 
 Now @racket[blog] structures can be read from the outside world with @racket[read] and written
@@ -809,7 +809,7 @@ At this point, we @emph{can} read and write the blog to disk. Now let's actually
 First, we'll make a place to record in the model where the blog lives on disk. So, we need to change
 the blog structure again. Now it will be:
 
-@defstruct[blog ([home string?] [posts (listof post?)]) #:mutable]
+@defstruct*[blog ([home string?] [posts (listof post?)]) #:mutable]
 
 @bold{Exercise.} Write the new structure definition for blogs.
 
@@ -820,14 +820,14 @@ Then, we'll make a function that allows our application to initialize the blog:
 @code:comment{Reads a blog from a path, if not present, returns default}
 (define (initialize-blog! home)
   (local [(define (log-missing-exn-handler exn)
-            (make-blog
+            (blog
              (path->string home)
-             (list (make-post "First Post"
-                              "This is my first post"
-                              (list "First comment!"))
-                   (make-post "Second Post"
-                              "This is another post"
-                              (list)))))
+             (list (post "First Post"
+                         "This is my first post"
+                         (list "First comment!"))
+                   (post "Second Post"
+                         "This is another post"
+                         (list)))))
           (define the-blog
             (with-handlers ([exn? log-missing-exn-handler])
               (with-input-from-file home read)))]
@@ -983,7 +983,7 @@ By adding a new comments table, we are more in accord with the relational style.
 
 A @racket[blog] structure will simply be a container for the database handle:
 
-@defstruct[blog ([db sqlite:db?])]
+@defstruct*[blog ([db sqlite:db?])]
 
 @bold{Exercise.} Write the @racket[blog] structure definition. (It does not need to be mutable or serializable.)
 
@@ -993,7 +993,7 @@ We can now write the code to initialize a @racket[blog] structure:
 @code:comment{Sets up a blog database (if it doesn't exist)}
 (define (initialize-blog! home)
   (define db (sqlite:open home))
-  (define the-blog (make-blog db))
+  (define the-blog (blog db))
   (with-handlers ([exn? void])
     (sqlite:exec/ignore db
                         (string-append
@@ -1056,7 +1056,7 @@ However, we cannot tell from this structure
 what blog this posts belongs to, and therefore, what database; so, we could not extract the title or body values,
 since we do not know what to query. Therefore, we should associate the blog with each post:
 
-@defstruct[post ([blog blog?] [id integer?])]
+@defstruct*[post ([blog blog?] [id integer?])]
 
 @bold{Exercise.} Write the structure definition for posts.
 
@@ -1067,7 +1067,7 @@ The only function that creates posts is @racket[blog-posts]:
 @code:comment{Queries for the post ids}
 (define (blog-posts a-blog)
   (local [(define (row->post a-row)
-            (make-post 
+            (post 
              a-blog
              (vector-ref a-row 0)))
           (define rows (sqlite:select
diff --git a/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt b/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt
index c18ee6451b..6e6a8a4066 100644
--- a/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/dummy-3.rkt
@@ -3,17 +3,17 @@
 
 ;; A blog is a (make-blog db)
 ;; where db is an sqlite database handle
-(define-struct blog (db))
+(struct blog (db))
 
 ;; A post is a (make-post blog id)
 ;; where blog is a blog and id is an integer?
-(define-struct post (blog id))
+(struct post (blog id))
 
 ;; initialize-blog! : path? -> blog?
 ;; Sets up a blog database (if it doesn't exist)
 (define (initialize-blog! home)
   (define db (sqlite:open home))
-  (define the-blog (make-blog db))
+  (define the-blog (blog db))
   (with-handlers ([exn? void])
     (sqlite:exec/ignore db
                         (string-append
@@ -35,7 +35,7 @@
 ;; Queries for the post ids
 (define (blog-posts a-blog)
   (local [(define (row->post a-row)
-            (make-post a-blog (string->number (vector-ref a-row 0))))
+            (post a-blog (string->number (vector-ref a-row 0))))
           (define rows (sqlite:select
                         (blog-db a-blog)
                         "SELECT id FROM posts"))]
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-1.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-1.rkt
index 76fa6d8630..54ebb4a53c 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-1.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-1.rkt
@@ -2,20 +2,20 @@
 
 ;; A blog is a (listof post)
 ;; and a post is a (make-post title body)
-(define-struct post (title body))
+(struct post (title body))
 
 ;; BLOG: blog
 ;; The static blog.
 (define BLOG 
-  (list (make-post "First Post" "This is my first post")
-        (make-post "Second Post" "This is another post")))
+  (list (post "First Post" "This is my first post")
+        (post "Second Post" "This is another post")))
 
 ;; start: request -> html-response
 ;; Consumes a request, and produces a page that displays all of the
 ;; web content.
 (define (start request)
   (render-blog-page BLOG request))
-  
+
 ;; render-blog-page: blog request -> html-response
 ;; Consumes a blog and a request, and produces an html-response page
 ;; of the content of the blog.
@@ -23,7 +23,7 @@
   `(html (head (title "My Blog"))
          (body (h1 "My Blog")
                ,(render-posts a-blog))))
-  
+
 ;; render-post: post -> html-response
 ;; Consumes a post, produces an html-response fragment of the post.
 (define (render-post a-post)
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-2.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-2.rkt
index f33b3f30ab..cdb6ba9a30 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-2.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-2.rkt
@@ -2,13 +2,13 @@
 
 ;; A blog is a (listof post)
 ;; and a post is a (make-post title body)
-(define-struct post (title body))
+(struct post (title body))
 
 ;; BLOG: blog
 ;; The static blog.
 (define BLOG 
-  (list (make-post "First Post" "This is my first post")
-        (make-post "Second Post" "This is another post")))
+  (list (post "First Post" "This is my first post")
+        (post "Second Post" "This is another post")))
 
 ;; start: request -> html-response
 ;; Consumes a request and produces a page that displays all of the
@@ -21,7 +21,7 @@
                   [else
                    BLOG]))]
     (render-blog-page a-blog request)))
-  
+
 
 ;; can-parse-post?: bindings -> boolean
 ;; Produces true if bindings contains values for 'title and 'body.
@@ -33,8 +33,8 @@
 ;; parse-post: bindings -> post
 ;; Consumes a bindings, and produces a post out of the bindings.
 (define (parse-post bindings)
-  (make-post (extract-binding/single 'title bindings)
-             (extract-binding/single 'body bindings)))
+  (post (extract-binding/single 'title bindings)
+        (extract-binding/single 'body bindings)))
 
 ;; render-blog-page: blog request -> html-response
 ;; Consumes a blog and a request, and produces an html-response page
@@ -49,8 +49,6 @@
            (input ((name "body")))
            (input ((type "submit")))))))
 
-
-
 ;; render-post: post -> html-response
 ;; Consumes a post, produces an html-response fragment of the post.
 (define (render-post a-post)
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-3.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-3.rkt
index 882f4c41e9..15fdc5f728 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-3.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-3.rkt
@@ -2,25 +2,25 @@
 
 ;; A blog is a (listof post)
 ;; and a post is a (make-post title body)
-(define-struct post (title body))
+(struct post (title body))
 
 ;; BLOG: blog
 ;; The static blog.
 (define BLOG 
-  (list (make-post "First Post" "This is my first post")
-        (make-post "Second Post" "This is another post")))
+  (list (post "First Post" "This is my first post")
+        (post "Second Post" "This is another post")))
 
 ;; start: request -> html-response
 ;; Consumes a request and produces a page that displays all of the
 ;; web content.
 (define (start request)
   (render-blog-page BLOG request))
-  
+
 ;; parse-post: bindings -> post
 ;; Extracts a post out of the bindings.
 (define (parse-post bindings)
-  (make-post (extract-binding/single 'title bindings)
-             (extract-binding/single 'body bindings)))
+  (post (extract-binding/single 'title bindings)
+        (extract-binding/single 'body bindings)))
 
 ;; render-blog-page: blog request -> html-response
 ;; Consumes a blog and a request, and produces an html-response page
@@ -33,16 +33,16 @@
                     ,(render-posts a-blog)
                     (form ((action 
                             ,(make-url insert-post-handler)))
-                     (input ((name "title")))
-                     (input ((name "body")))
-                     (input ((type "submit")))))))
+                          (input ((name "title")))
+                          (input ((name "body")))
+                          (input ((type "submit")))))))
           
           (define (insert-post-handler request)
             (render-blog-page 
              (cons (parse-post (request-bindings request))
                    a-blog)
              request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post: post -> html-response
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-4.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-4.rkt
index 3a5a766a57..d58660bd03 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-4.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-4.rkt
@@ -2,25 +2,25 @@
 
 ;; A blog is a (make-blog posts)
 ;; where posts is a (listof post)
-(define-struct blog (posts) #:mutable)
+(struct blog (posts) #:mutable)
 
 ;; and post is a (make-post title body)
 ;; where title is a string, and body is a string
-(define-struct post (title body))
+(struct post (title body))
 
 ;; BLOG: blog
 ;; The initial BLOG.
 (define BLOG 
-  (make-blog
-   (list (make-post "First Post" "This is my first post")
-         (make-post "Second Post" "This is another post"))))
+  (blog
+   (list (post "First Post" "This is my first post")
+         (post "Second Post" "This is another post"))))
 
 ;; blog-insert-post!: blog post -> void
 ;; Consumes a blog and a post, adds the post at the top of the blog.
 (define (blog-insert-post! a-blog a-post)
   (set-blog-posts! a-blog
                    (cons a-post (blog-posts a-blog))))
-  
+
 ;; start: request -> html-response
 ;; Consumes a request and produces a page that displays
 ;; all of the web content.
@@ -30,8 +30,8 @@
 ;; parse-post: bindings -> post
 ;; Extracts a post out of the bindings.
 (define (parse-post bindings)
-  (make-post (extract-binding/single 'title bindings)
-             (extract-binding/single 'body bindings)))
+  (post (extract-binding/single 'title bindings)
+        (extract-binding/single 'body bindings)))
 
 ;; render-blog-page: request -> html-response
 ;; Produces an html-response page of the content of the BLOG.
@@ -43,15 +43,15 @@
                     ,(render-posts)
                     (form ((action 
                             ,(make-url insert-post-handler)))
-                     (input ((name "title")))
-                     (input ((name "body")))
-                     (input ((type "submit")))))))
+                          (input ((name "title")))
+                          (input ((name "body")))
+                          (input ((type "submit")))))))
           
           (define (insert-post-handler request)
             (blog-insert-post! 
              BLOG (parse-post (request-bindings request)))
             (render-blog-page request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post: post -> html-response
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-5.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-5.rkt
index 807c0bea78..8263efdd8c 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-5.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-5.rkt
@@ -2,23 +2,23 @@
 
 ;; A blog is a (make-blog posts)
 ;; where posts is a (listof post)
-(define-struct blog (posts) #:mutable)
+(struct blog (posts) #:mutable)
 
 ;; and post is a (make-post title body comments)
 ;; where title is a string, body is a string,
 ;; and comments is a (listof string)
-(define-struct post (title body comments) #:mutable)
+(struct post (title body comments) #:mutable)
 
 ;; BLOG: blog
 ;; The initial BLOG.
 (define BLOG 
-  (make-blog
-   (list (make-post "First Post" 
-                    "This is my first post" 
-                    (list "First comment!"))
-         (make-post "Second Post" 
-                    "This is another post"
-                    (list)))))
+  (blog
+   (list (post "First Post" 
+               "This is my first post" 
+               (list "First comment!"))
+         (post "Second Post" 
+               "This is another post"
+               (list)))))
 
 ;; blog-insert-post!: blog post -> void
 ;; Consumes a blog and a post, adds the post at the top of the blog.
@@ -52,22 +52,22 @@
                     ,(render-posts make-url)
                     (form ((action 
                             ,(make-url insert-post-handler)))
-                     (input ((name "title")))
-                     (input ((name "body")))
-                     (input ((type "submit")))))))
+                          (input ((name "title")))
+                          (input ((name "body")))
+                          (input ((type "submit")))))))
           
           ;; parse-post: bindings -> post
           ;; Extracts a post out of the bindings.
           (define (parse-post bindings)
-            (make-post (extract-binding/single 'title bindings)
-                       (extract-binding/single 'body bindings)
-                       (list)))
+            (post (extract-binding/single 'title bindings)
+                  (extract-binding/single 'body bindings)
+                  (list)))
           
           (define (insert-post-handler request)
             (blog-insert-post!
              BLOG (parse-post (request-bindings request)))
             (render-blog-page request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post-detail-page: post request -> html-response
@@ -86,7 +86,7 @@
                             ,(make-url insert-comment-handler)))
                           (input ((name "comment")))
                           (input ((type "submit")))))))
-
+          
           (define (parse-comment bindings)
             (extract-binding/single 'comment bindings))
           
@@ -94,8 +94,8 @@
             (post-insert-comment! 
              a-post (parse-comment (request-bindings a-request)))
             (render-post-detail-page a-post a-request))]
-
-
+    
+    
     (send/suspend/dispatch response-generator)))
 
 
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-6.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-6.rkt
index aff791c8e8..0d9fa491e4 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-6.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-6.rkt
@@ -2,23 +2,23 @@
 
 ;; A blog is a (make-blog posts)
 ;; where posts is a (listof post)
-(define-struct blog (posts) #:mutable)
+(struct blog (posts) #:mutable)
 
 ;; and post is a (make-post title body comments)
 ;; where title is a string, body is a string,
 ;; and comments is a (listof string)
-(define-struct post (title body comments) #:mutable)
+(struct post (title body comments) #:mutable)
 
 ;; BLOG: blog
 ;; The initial BLOG.
 (define BLOG 
-  (make-blog
-   (list (make-post "First Post" 
-                    "This is my first post" 
-                    (list "First comment!"))
-         (make-post "Second Post" 
-                    "This is another post"
-                    (list)))))
+  (blog
+   (list (post "First Post" 
+               "This is my first post" 
+               (list "First comment!"))
+         (post "Second Post" 
+               "This is another post"
+               (list)))))
 
 ;; blog-insert-post!: blog post -> void
 ;; Consumes a blog and a post, adds the post at the top of the blog.
@@ -52,22 +52,22 @@
                     ,(render-posts make-url)
                     (form ((action 
                             ,(make-url insert-post-handler)))
-                     (input ((name "title")))
-                     (input ((name "body")))
-                     (input ((type "submit")))))))
+                          (input ((name "title")))
+                          (input ((name "body")))
+                          (input ((type "submit")))))))
           
           ;; parse-post: bindings -> post
           ;; Extracts a post out of the bindings.
           (define (parse-post bindings)
-            (make-post (extract-binding/single 'title bindings)
-                       (extract-binding/single 'body bindings)
-                       (list)))
+            (post (extract-binding/single 'title bindings)
+                  (extract-binding/single 'body bindings)
+                  (list)))
           
           (define (insert-post-handler request)
             (blog-insert-post!
              BLOG (parse-post (request-bindings request)))
             (render-blog-page request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post-detail-page: post request -> html-response
@@ -101,7 +101,7 @@
           
           (define (back-handler request)
             (render-blog-page request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-confirm-add-comment-page :
@@ -130,7 +130,7 @@
           
           (define (cancel-handler request)
             (render-post-detail-page a-post request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post: post (handler -> string) -> html-response
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-7.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-7.rkt
index 451d15a3f4..2f395e269c 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-7.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-7.rkt
@@ -2,23 +2,23 @@
 
 ;; A blog is a (make-blog posts)
 ;; where posts is a (listof post)
-(define-struct blog (posts) #:mutable)
+(struct blog (posts) #:mutable)
 
 ;; and post is a (make-post title body comments)
 ;; where title is a string, body is a string,
 ;; and comments is a (listof string)
-(define-struct post (title body comments) #:mutable)
+(struct post (title body comments) #:mutable)
 
 ;; BLOG: blog
 ;; The initial BLOG.
 (define BLOG 
-  (make-blog
-   (list (make-post "First Post" 
-                    "This is my first post" 
-                    (list "First comment!"))
-         (make-post "Second Post" 
-                    "This is another post"
-                    (list)))))
+  (blog
+   (list (post "First Post" 
+               "This is my first post" 
+               (list "First comment!"))
+         (post "Second Post" 
+               "This is another post"
+               (list)))))
 
 ;; blog-insert-post!: blog post -> void
 ;; Consumes a blog and a post, adds the post at the top of the blog.
@@ -52,22 +52,22 @@
                     ,(render-posts make-url)
                     (form ((action
                             ,(make-url insert-post-handler)))
-                     (input ((name "title")))
-                     (input ((name "body")))
-                     (input ((type "submit")))))))
+                          (input ((name "title")))
+                          (input ((name "body")))
+                          (input ((type "submit")))))))
           
           ;; parse-post: bindings -> post
           ;; Extracts a post out of the bindings.
           (define (parse-post bindings)
-            (make-post (extract-binding/single 'title bindings)
-                       (extract-binding/single 'body bindings)
-                       (list)))
+            (post (extract-binding/single 'title bindings)
+                  (extract-binding/single 'body bindings)
+                  (list)))
           
           (define (insert-post-handler request)
             (blog-insert-post!
              BLOG (parse-post (request-bindings request)))
             (render-blog-page (redirect/get)))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post-detail-page: post request -> html-response
@@ -98,10 +98,10 @@
              (parse-comment (request-bindings request))
              a-post
              request))
-
+          
           (define (back-handler request)
             (render-blog-page request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-confirm-add-comment-page :
@@ -130,7 +130,7 @@
           
           (define (cancel-handler request)
             (render-post-detail-page a-post request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post: post (handler -> string) -> html-response
diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-8.rkt b/collects/web-server/scribblings/tutorial/examples/iteration-8.rkt
index 28520978d8..45fa7b3e25 100644
--- a/collects/web-server/scribblings/tutorial/examples/iteration-8.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/iteration-8.rkt
@@ -19,22 +19,22 @@
                     ,(render-posts make-url)
                     (form ((action
                             ,(make-url insert-post-handler)))
-                     (input ((name "title")))
-                     (input ((name "body")))
-                     (input ((type "submit")))))))
+                          (input ((name "title")))
+                          (input ((name "body")))
+                          (input ((type "submit")))))))
           
           ;; parse-post: bindings -> post
           ;; Extracts a post out of the bindings.
           (define (parse-post bindings)
-            (make-post (extract-binding/single 'title bindings)
-                       (extract-binding/single 'body bindings)
-                       (list)))
+            (post (extract-binding/single 'title bindings)
+                  (extract-binding/single 'body bindings)
+                  (list)))
           
           (define (insert-post-handler request)
             (blog-insert-post!
              BLOG (parse-post (request-bindings request)))
             (render-blog-page (redirect/get)))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post-detail-page: post request -> html-response
@@ -65,10 +65,10 @@
              (parse-comment (request-bindings request))
              a-post
              request))
-
+          
           (define (back-handler request)
             (render-blog-page request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-confirm-add-comment-page :
@@ -97,7 +97,7 @@
           
           (define (cancel-handler request)
             (render-post-detail-page a-post request))]
-
+    
     (send/suspend/dispatch response-generator)))
 
 ;; render-post: post (handler -> string) -> html-response
diff --git a/collects/web-server/scribblings/tutorial/examples/model-2.rkt b/collects/web-server/scribblings/tutorial/examples/model-2.rkt
index 5cac68e31a..58260c2924 100644
--- a/collects/web-server/scribblings/tutorial/examples/model-2.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/model-2.rkt
@@ -2,25 +2,25 @@
 
 ;; A blog is a (make-blog home posts)
 ;; where home is a string, posts is a (listof post)
-(define-struct blog (home posts) #:mutable #:prefab)
+(struct blog (home posts) #:mutable #:prefab)
 
 ;; and post is a (make-post blog title body comments)
 ;; where title is a string, body is a string,
 ;; and comments is a (listof string)
-(define-struct post (title body comments) #:mutable #:prefab)
+(struct post (title body comments) #:mutable #:prefab)
 
 ;; initialize-blog! : path? -> blog
 ;; Reads a blog from a path, if not present, returns default
 (define (initialize-blog! home)
   (local [(define (log-missing-exn-handler exn)
-            (make-blog
+            (blog
              (path->string home)
-             (list (make-post "First Post"
-                              "This is my first post"
-                              (list "First comment!"))
-                   (make-post "Second Post"
-                              "This is another post"
-                              (list)))))
+             (list (post "First Post"
+                         "This is my first post"
+                         (list "First comment!"))
+                   (post "Second Post"
+                         "This is another post"
+                         (list)))))
           (define the-blog
             (with-handlers ([exn? log-missing-exn-handler])
               (with-input-from-file home read)))]
@@ -41,7 +41,7 @@
 (define (blog-insert-post! a-blog title body)
   (set-blog-posts! 
    a-blog
-   (cons (make-post title body empty) (blog-posts a-blog)))
+   (cons (post title body empty) (blog-posts a-blog)))
   (save-blog! a-blog))
 
 ;; post-insert-comment!: blog post string -> void
diff --git a/collects/web-server/scribblings/tutorial/examples/model-3.rkt b/collects/web-server/scribblings/tutorial/examples/model-3.rkt
index 1729309951..ee30d332eb 100644
--- a/collects/web-server/scribblings/tutorial/examples/model-3.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/model-3.rkt
@@ -3,17 +3,17 @@
 
 ;; A blog is a (make-blog db)
 ;; where db is an sqlite database handle
-(define-struct blog (db))
+(struct blog (db))
 
 ;; A post is a (make-post blog id)
 ;; where blog is a blog and id is an integer?
-(define-struct post (blog id))
+(struct post (blog id))
 
 ;; initialize-blog! : path? -> blog?
 ;; Sets up a blog database (if it doesn't exist)
 (define (initialize-blog! home)
   (define db (sqlite:open home))
-  (define the-blog (make-blog db))
+  (define the-blog (blog db))
   (with-handlers ([exn? void])
     (sqlite:exec/ignore db
                         (string-append
@@ -35,7 +35,7 @@
 ;; Queries for the post ids
 (define (blog-posts a-blog)
   (local [(define (row->post a-row)
-            (make-post 
+            (post 
              a-blog
              (vector-ref a-row 0)))
           (define rows (sqlite:select
diff --git a/collects/web-server/scribblings/tutorial/examples/model.rkt b/collects/web-server/scribblings/tutorial/examples/model.rkt
index 0219b20a77..c9676ab0f7 100644
--- a/collects/web-server/scribblings/tutorial/examples/model.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/model.rkt
@@ -2,23 +2,23 @@
 
 ;; A blog is a (make-blog posts)
 ;; where posts is a (listof post)
-(define-struct blog (posts) #:mutable)
+(struct blog (posts) #:mutable)
 
 ;; and post is a (make-post title body comments)
 ;; where title is a string, body is a string, 
 ;; and comments is a (listof string)
-(define-struct post (title body comments) #:mutable)
+(struct post (title body comments) #:mutable)
 
 ;; BLOG: blog
 ;; The initial BLOG.
 (define BLOG 
-  (make-blog
-   (list (make-post "First Post" 
-                    "This is my first post" 
-                    (list "First comment!"))
-         (make-post "Second Post" 
-                    "This is another post"
-                               (list)))))
+  (blog
+   (list (post "First Post" 
+               "This is my first post" 
+               (list "First comment!"))
+         (post "Second Post" 
+               "This is another post"
+               (list)))))
 
 ;; blog-insert-post!: blog post -> void
 ;; Consumes a blog and a post, adds the post at the top of the blog.
diff --git a/collects/web-server/scribblings/tutorial/examples/no-use-redirect.rkt b/collects/web-server/scribblings/tutorial/examples/no-use-redirect.rkt
index 59f172be78..ddf48c4eff 100644
--- a/collects/web-server/scribblings/tutorial/examples/no-use-redirect.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/no-use-redirect.rkt
@@ -2,7 +2,7 @@
 
 ;; A roster is a (make-roster names)
 ;; where names is a list of string.
-(define-struct roster (names) #:mutable)
+(struct roster (names) #:mutable)
 
 ;; roster-add-name!: roster string -> void
 ;; Given a roster and a name, adds the name
@@ -12,7 +12,7 @@
                     (append (roster-names a-roster)
                             (list a-name))))
 
-(define ROSTER (make-roster '("kathi" "shriram" "dan")))
+(define ROSTER (roster '("kathi" "shriram" "dan")))
 
 ;; start: request -> html-response
 (define (start request)
diff --git a/collects/web-server/scribblings/tutorial/examples/use-redirect.rkt b/collects/web-server/scribblings/tutorial/examples/use-redirect.rkt
index b69ea84f53..7d3fc30e8a 100644
--- a/collects/web-server/scribblings/tutorial/examples/use-redirect.rkt
+++ b/collects/web-server/scribblings/tutorial/examples/use-redirect.rkt
@@ -2,7 +2,7 @@
 
 ;; A roster is a (make-roster names)
 ;; where names is a list of string.
-(define-struct roster (names) #:mutable)
+(struct roster (names) #:mutable)
 
 ;; roster-add-name!: roster string -> void
 ;; Given a roster and a name, adds the name
@@ -12,7 +12,7 @@
                     (append (roster-names a-roster)
                             (list a-name))))
 
-(define ROSTER (make-roster '("kathi" "shriram" "dan")))
+(define ROSTER (roster '("kathi" "shriram" "dan")))
 
 ;; start: request -> html-response
 (define (start request)
diff --git a/collects/web-server/servlet-dispatch.rkt b/collects/web-server/servlet-dispatch.rkt
index 251f0830d3..2e063e5824 100644
--- a/collects/web-server/servlet-dispatch.rkt
+++ b/collects/web-server/servlet-dispatch.rkt
@@ -135,7 +135,7 @@
                   (if launch-path 
                       (string-append server-url launch-path)
                       server-url))
-          (printf "Click 'Stop' at any time to terminate the Web Server.\n"))
+          (printf "Stop this program at any time to terminate the Web Server.\n"))
         (let ([bye (lambda ()
                      (when banner? (printf "\nWeb Server stopped.\n"))
                      (shutdown-server))])