diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/class.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/class.rkt
index 9f1b213dbf..9ac6f8435a 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/class.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/class.rkt
@@ -33,6 +33,13 @@
               'pos
               'neg))
   
+  (test/spec-passed
+   'class/c-first-order-opaque-class-3
+   '(contract (class/c #:opaque m)
+              (class object% (super-new) (define/public (m) 3))
+              'pos
+              'neg))
+  
   (test/pos-blame
    'class/c-first-order-method-1
    '(contract (class/c [m (-> any/c number? number?)])
@@ -1108,6 +1115,22 @@
            [d%/c/c (contract (class/c (init [a number?])) d%/c 'pos 'neg)])
       (new d%/c/c [a #t] [a "foo"])))
   
+  (test/spec-passed
+   'class/c-higher-order-init-9
+   '(let ([c% (contract (class/c (init [a number?]))
+                        (class object% (super-new) (init a))
+                        'pos
+                        'neg)])
+      (make-object c% 3)))
+  
+  (test/neg-blame
+   'class/c-higher-order-init-10
+   '(let ([c% (contract (class/c (init [a number?]))
+                        (class object% (super-new) (init a))
+                        'pos
+                        'neg)])
+      (make-object c% #f)))
+  
   (test/spec-passed
    'class/c-higher-order-init-field-1
    '(let ([c% (contract (class/c (init-field [f (-> number? number?)]))
@@ -2085,6 +2108,44 @@
       x)
    1)
   
+  (test/pos-blame
+   'class/c-field-in-class-with-interface-ctc
+   '(get-field f (new (contract (class/c (field [f integer?]))
+                                (class* object% ((interface () [m (-> any/c integer?)]))
+                                  (field [f #f])
+                                  (define/public (m) 1)
+                                  (super-new))
+                                'pos
+                                'neg))))
+  
+  (test/pos-blame
+   'class/c-field-in-class-with-interface-ctc2
+   '(new (contract (class/c (field f))
+                   (class* object% ((interface () [m (-> any/c integer?)]))
+                     (define/public (m) 1)
+                     (super-new))
+                   'pos
+                   'neg)))
+  
+  (test/pos-blame
+   'class/c-absent-in-class-with-interface-ctc
+   '(contract (class/c (absent m))
+              (class* object% ((interface () [m (-> any/c integer?)]))
+                (define/public (m) 1)
+                (super-new))
+              'pos
+              'neg))
+  
+  (test/pos-blame
+   'class/c-absent-in-class-with-interface-ctc
+   '(contract (class/c (absent (field f)))
+              (class* object% ((interface () [m (-> any/c integer?)]))
+                (define/public (m) 1)
+                (field [f 1])
+                (super-new))
+              'pos
+              'neg))
+  
   (let ([expected-given?
          (λ (exn) (and (regexp-match? #rx"callback: contract violation" (exn-message exn))
                        (regexp-match? #rx"expected: boolean[?]" (exn-message exn))
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/first-order.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/first-order.rkt
index 315611a262..0ec37a638a 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/first-order.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/first-order.rkt
@@ -203,8 +203,4 @@
   (ctest #t contract-first-order-passes?
          (class/c [m (-> any/c integer? integer?)]) 
          (class* object% ((interface () [m (-> any/c integer? integer?)]))
-           (define/public (m x) x)))
-  
-  
-  
-  )
+           (define/public (m x) x))))
diff --git a/racket/collects/racket/class.rkt b/racket/collects/racket/class.rkt
index ef06d2510e..a3be91a65b 100644
--- a/racket/collects/racket/class.rkt
+++ b/racket/collects/racket/class.rkt
@@ -6,7 +6,8 @@
 ;; All of the implementation is actually in private/class-internal.rkt,
 ;;  which provides extra (private) functionality to contract.rkt.
 (require "private/class-internal.rkt"
-         "private/class-c-old.rkt")
+         (except-in "private/class-c-old.rkt" class/c)
+         (rename-in "private/class-c-new.rkt" [class/c2 class/c]))
   
 (provide-public-names)
 (provide generic?)
diff --git a/racket/collects/racket/private/class-c-new.rkt b/racket/collects/racket/private/class-c-new.rkt
index 3f11fb8ab6..621153eb58 100644
--- a/racket/collects/racket/private/class-c-new.rkt
+++ b/racket/collects/racket/private/class-c-new.rkt
@@ -11,126 +11,6 @@
 
 (provide class/c2)
 
-(define-for-syntax (parse-class/c stx)
-  (define (give-up) (values #f #f #f #f #f))
-  (define-values (opaque? args)
-    (syntax-case stx ()
-      [(_ #:opaque args ...)
-       (values #t #'(args ...))]
-      [(_ args ...)
-       (let ()
-         (define stx-args #'(args ...))
-         (define l (syntax->list stx-args))
-         (printf "l ~\n" l)
-         (when (and (pair? l) (keyword? (syntax-e (car l))))
-           (raise-syntax-error #f "unrecognized keyword" stx (car l)))
-         (values #f stx-args))]))
-  (syntax-case args ()
-    [(clauses ...)
-     (let loop ([clauses (syntax->list #'(clauses ...))]
-                [mths '()]
-                [flds '()]
-                [inits '()]
-                [let-bindings '()])
-       (cond
-         [(null? clauses) 
-          (values opaque?
-                  (reverse mths)
-                  (reverse flds)
-                  (reverse inits)
-                  (reverse let-bindings))]
-         [else
-          (syntax-case (car clauses) (field inherit inherit-field init init-field super inner 
-                                            override augment augride absent)
-            [(super . x) (give-up)]
-            [(inner . x) (give-up)]
-            [(override . x) (give-up)]
-            [(augment . x) (give-up)]
-            [(augride . x) (give-up)]
-            [(absent . x) (give-up)]
-            [(inherit . x) (give-up)]
-            [(inherit-field . x) (give-up)]
-            [(field x ...) (give-up)]
-            [(init x ...) 
-             (let ()
-               (define new-let-bindings let-bindings)
-               (define new-inits '())
-               (for ([clause (in-list (syntax->list #'(x ...)))])
-                 (syntax-case clause ()
-                   [(id ctc)
-                    (with-syntax ([(x) (generate-temporaries #'(id))])
-                      (set! new-let-bindings (cons #`[x ctc] new-let-bindings))
-                      (set! new-inits (cons #`[id x] new-inits)))]
-                   [id
-                    (identifier? #'id)
-                    (begin
-                      (set! new-inits (cons #`[id just-check-existence] new-inits)))]
-                   [_
-                    (raise-syntax-error 'class/c "expected a field-spec" stx clause)]))
-               (loop (cdr clauses)
-                     mths flds (append new-inits inits) new-let-bindings))]
-            [(init-field x ...)
-             (let ()
-               (define new-let-bindings let-bindings)
-               (define clauses '())
-               (for ([cl (in-list (syntax->list #'(x ...)))])
-                 (syntax-case cl ()
-                   [(id ctc) 
-                    (identifier? #'id)
-                    (with-syntax ([(x) (generate-temporaries (list #'id))])
-                      (set! new-let-bindings (cons #`[x ctc] new-let-bindings))
-                      (set! clauses (cons #'[id x] clauses)))]
-                   [id
-                    (identifier? #'id)
-                    (begin
-                      (set! clauses (cons #'[id just-check-existence] clauses)))]
-                   [_
-                    (raise-syntax-error 'class/c "expected a field-spec" stx cl)]))
-               (loop (cdr clauses) mths (append clauses flds) (append clauses inits)
-                     new-let-bindings))]
-                                           
-            [x (identifier? #'x) 
-               (loop (cdr clauses) 
-                     (cons #`[#,(car clauses) just-check-existence] mths)
-                     flds inits let-bindings)]
-            [[mth ctc] 
-             (identifier? #'mth)
-             (with-syntax ([(x) (generate-temporaries #'(mth))])
-               (loop (cdr clauses) 
-                     (cons #`[mth x] mths)
-                     flds
-                     inits
-                     (cons #`[x ctc] let-bindings)))]
-            [else (give-up)])]))]))
-
-#;
-(define-syntax (class/c2 stx)
-  (define-values (opaque? mths flds inits let-bindings) (parse-class/c stx))
-  (cond
-    [(and mths (null? flds))
-     (syntax-case (list mths inits) ()
-       [(((mth-name mth-ctc) ...)
-         ((init-name init-ctc) ...))
-        ;(printf " yup: ~a:~a\n" (syntax-source stx) (syntax-line stx))
-        (with-syntax ([(lmth-name ...) (for/list ([m (in-list (syntax->list #'(mth-name ...)))])
-                                         (localize m))]
-                      [name (syntax-local-infer-name stx)])
-          ;#'(class/c [m ctc] ...)
-          #`(let #,let-bindings
-              (make-an-ext-class/c-contract '#,opaque?
-                                            (list `lmth-name ...)
-                                            (list mth-ctc ...)
-                                            '() '()
-                                            (list 'init-name ...)
-                                            (list init-ctc ...)
-                                            'name
-                                            empty-internal/c)))])]
-    [else
-     ;(printf "nope: ~a:~a\n" (syntax-source stx) (syntax-line stx))
-     (syntax-case stx ()
-       [(_ args ...)
-        #'(class/c args ...)])]))
-
 (define-syntax (class/c2 stx)
   (define-values (opaque? args)
     (syntax-case stx ()
@@ -143,7 +23,6 @@
            (raise-syntax-error #f "unrecognized keyword" stx (car stx-args)))
          (values #f stx-args))]))
   (define-values (bindings pfs) (parse-class/c-specs args #f))
-  (printf ">> ~s ~s\n" bindings (hash-ref pfs 'methods null))
   (with-syntax ([methods #`(list #,@(reverse (hash-ref pfs 'methods null)))]
                 [method-ctcs #`(list #,@(reverse (hash-ref pfs 'method-contracts null)))]
                 [fields #`(list #,@(reverse (hash-ref pfs 'fields null)))]
@@ -182,22 +61,23 @@
                   [opaque? opaque?])
       (syntax/loc stx
         (let bindings
-;          (let-values ([(inits init-ctcs) (sort-inits+contracts (list (cons i i-c) ...))])
-            (make-an-ext-class/c-contract
-             'opaque?
-             methods method-ctcs
-             fields field-ctcs
-             (list 'i ...)
-             (list i-c ...)
-             'name
-             (internal-class/c
-              inherits inherit-ctcs
-              inherit-fields inherit-field-ctcs
-              supers super-ctcs
-              inners inner-ctcs
-              overrides override-ctcs
-              augments augment-ctcs
-              augrides augride-ctcs)))))))
+          (make-an-ext-class/c-contract
+           'opaque?
+           methods method-ctcs
+           fields field-ctcs
+           (list i ...)
+           (list i-c ...)
+           absents 
+           absent-fields
+           'name
+           (build-internal-class/c
+            inherits inherit-ctcs
+            inherit-fields inherit-field-ctcs
+            supers super-ctcs
+            inners inner-ctcs
+            overrides override-ctcs
+            augments augment-ctcs
+            augrides augride-ctcs)))))))
 
 (define (class/c2-proj this)
   (λ (blame)
@@ -224,13 +104,23 @@
                         (if (just-check-existence? ctc) 
                             any/c
                             ctc))))
+              
+              (define fields 
+                (for/list ([(fld ctc) (in-hash (ext-class/c-contract-table-of-flds-to-ctcs this))])
+                  fld))
+              (define field-ctcs
+                (for/list ([(fld ctc) (in-hash (ext-class/c-contract-table-of-flds-to-ctcs this))])
+                  (if (just-check-existence? ctc)
+                      #f
+                      ctc)))
+              
               (define ctc
                 (make-class/c
                  ;; methods
                  (map car mth-lst)
                  (map cdr mth-lst)
                  
-                 '() '() ;; fields  
+                 fields field-ctcs
                  
                  ;; inits
                  (map (λ (x) (list-ref x 0)) (ext-class/c-contract-init-ctc-pairs this))
@@ -241,14 +131,17 @@
                             ctc))
                       (ext-class/c-contract-init-ctc-pairs this))
                  
-                 '() '() ;; absent
-                 empty-internal-class/c
-                 #f ;; opaque?
-                 #f ;; name
-                 ))
+                 (ext-class/c-contract-absent-methods this)
+                 (ext-class/c-contract-absent-fields this)
+
+                 (ext-class/c-contract-internal-ctc this)
+                 (ext-class/c-contract-opaque? this)
+                 (ext-class/c-contract-name this)))
               (λ (neg-party)
                 (((class/c-proj ctc) (blame-add-missing-party blame neg-party)) cls))]
-             [else (build-neg-acceptor-proc this maybe-err blame cls (make-hash) '())])]
+             [else 
+              (build-neg-acceptor-proc this maybe-err blame cls (make-hash) '() 
+                                       (make-hasheq) (make-hasheq))])]
           [(wrapped-class? cls) 
            (define neg-acceptors-ht
              (wrapped-class-info-neg-acceptors-ht (wrapped-class-the-info cls)))
@@ -266,7 +159,9 @@
            (build-neg-acceptor-proc this maybe-err blame 
                                     (wrapped-class-info-class the-info)
                                     new-mths-ht
-                                    fixed-neg-init-projs)]
+                                    fixed-neg-init-projs
+                                    (wrapped-class-info-pos-field-projs the-info)
+                                    (wrapped-class-info-neg-field-projs the-info))]
           [else
            (maybe-err
             (λ (neg-party)
@@ -274,20 +169,13 @@
                blame #:missing-party neg-party cls
                '(expected: "a class"))))])))))
 
-(define empty-internal-class/c
-  (internal-class/c
-   '() '() ;; inherit
-   '() '() ;; inherit fields
-   '() '() ;; super
-   '() '() ;; inner
-   '() '() ;; override
-   '() '() ;; augment
-   '() '())) ;; augride
-
-(define (build-neg-acceptor-proc this maybe-err blame cls new-mths-ht old-init-pairs)
+(define (build-neg-acceptor-proc this maybe-err blame cls new-mths-ht old-init-pairs 
+                                 old-pos-fld-ht old-neg-fld-ht)
   (define mth->idx (class-method-ht cls))
   (define mtd-vec (class-methods cls))
   
+  (define internal-proj (internal-class/c-proj (ext-class/c-contract-internal-ctc this)))
+  
   (define (get-unwrapped-method name)
     (cond
       [(hash-ref new-mths-ht name #f) => values]
@@ -299,6 +187,9 @@
   (define neg-extra-arg-ht (make-hash))
   (define neg-acceptors-ht (make-hash))
   
+  (define pos-field-projs (hash-copy old-pos-fld-ht))
+  (define neg-field-projs (hash-copy old-neg-fld-ht))
+  
   (define (generic-wrapper mth)
     (define raw-proc (get-unwrapped-method mth))
     (make-keyword-procedure
@@ -322,7 +213,7 @@
        ;; if we just check the method's existence,
        ;; then make an inefficient wrapper for it
        ;; that discards the neg-party argument
-       (generic-wrapper mth)]
+       (hash-set! neg-extra-arg-ht mth (generic-wrapper mth))]
       [else
        (define w/blame (proj (blame-add-method-context blame mth)))
        (define projd-mth (w/blame m-mth))
@@ -341,7 +232,16 @@
                (apply (projd-mth neg-party) args)))]))
        (hash-set! neg-extra-arg-ht mth neg-acceptor)]))
   
+  (define absent-methods (ext-class/c-contract-absent-methods this))
   (for ([(mth _) (in-hash mth->idx)])
+    (when (member mth absent-methods)
+      (maybe-err
+       (λ (neg-party)
+         (raise-blame-error 
+          blame #:missing-party neg-party cls
+          '(expected: "a class that does not have the method ~a")
+          mth))))
+    
     ;; use a generic wrapper to drop the neg-party argument, which means
     ;; methods without explicit contracts are going to be slow
     (unless (hash-ref neg-extra-arg-ht mth #f)
@@ -353,7 +253,7 @@
                  (format " ~a" mth)))
              (raise-blame-error 
               blame #:missing-party neg-party cls
-              '(expected: "~a" given: "a class that has a method ~a")
+              '(expected: "~a" given: "a class that has a method: ~a")
               (cond
                 [(null? mth-names) "a class with no methods"]
                 [(null? (cdr mth-names)) 
@@ -363,6 +263,58 @@
                          (apply string-append mth-names))])
               mth)))
           (hash-set! neg-extra-arg-ht mth (generic-wrapper mth)))))
+  
+  (for ([(fld proj) (in-hash (ext-class/c-contract-table-of-flds-to-projs this))])
+    (define field-ht (class-field-ht cls))
+    (define fi (hash-ref field-ht fld #f))
+    (unless fi
+      (maybe-err
+       (λ (neg-party)
+         (raise-blame-error 
+          blame #:missing-party neg-party cls
+          '(expected: "a class with a public field named ~a")
+          fld))))
+    
+    (unless (just-check-existence? proj)
+      (define (update-ht field-projs field-info-internal-ref/set! swap?)
+        (define prior (hash-ref field-projs fld (λ () (field-info-internal-ref/set! fi))))
+        (define w-blame (proj (blame-add-field-context blame proj #:swap? swap?)))
+        (hash-set! field-projs fld (cons w-blame prior)))
+      (update-ht pos-field-projs field-info-internal-ref #f)
+      (update-ht neg-field-projs field-info-internal-set! #t)))
+  
+  (define absent-fields (ext-class/c-contract-absent-fields this))
+  (unless (null? absent-fields)
+    (for ([(fld proj) (in-hash (class-field-ht cls))])
+      (when (member fld absent-fields)
+        (maybe-err
+         (λ (neg-party)
+           (raise-blame-error 
+            blame #:missing-party neg-party cls
+            '(expected: "a class that does not have the field ~a")
+            fld))))))
+  
+  (when (ext-class/c-contract-opaque? this)
+    (define allowed-flds (ext-class/c-contract-table-of-flds-to-projs this))
+    (for ([(fld proj) (in-hash (class-field-ht cls))])
+      (unless (hash-ref allowed-flds fld #f)
+        (maybe-err
+         (λ (neg-party)
+           (define fld-names
+             (for/list ([(fld proj) (in-hash allowed-flds)])
+               (format " ~a" fld)))
+           (raise-blame-error 
+            blame #:missing-party neg-party cls
+            '(expected: "~a" given: "a class that has the field: ~a")
+            (cond
+              [(null? fld-names) "a class with no fields"]
+              [(null? (cdr fld-names))
+               (format "a class with only one field:~a" (car fld-names))]
+              [else
+               (format "a class with only the fields:~a" 
+                       (apply string-append fld-names))])
+            fld))))))
+      
   (define new-init-projs 
     (for/list ([ctc-pair (in-list (ext-class/c-contract-init-ctc-pairs this))])
       (define ctc (list-ref ctc-pair 1))
@@ -374,14 +326,28 @@
                  (blame-add-init-context blame (car ctc-pair)))))))
   (define merged-init-pairs (merge-init-pairs old-init-pairs new-init-projs))
   (define the-info (wrapped-class-info cls blame neg-extra-arg-ht neg-acceptors-ht 
+                                       pos-field-projs neg-field-projs
                                        merged-init-pairs))
+  
   (λ (neg-party)
     ;; run this for the side-effect of 
     ;; checking that first-order tests on
     ;; methods (arity, etc) all pass
     (for ([(mth neg-party-acceptor) (in-hash neg-acceptors-ht)])
       (neg-party-acceptor neg-party))
-    (wrapped-class the-info neg-party)))
+    
+    ;; XXX: we have to not do this;
+    ;; (instead we should use just the-info)
+    ;; the internal projection should run
+    ;; on the class only when it is
+    ;; time to instantiate it; not here
+    (define the-info/adjusted-cls
+      (struct-copy wrapped-class-info
+                   the-info
+                   [class ((internal-proj (blame-add-missing-party blame neg-party))
+                           cls)]))
+    
+    (wrapped-class the-info/adjusted-cls neg-party)))
 
 (define (merge-init-pairs old-init-pairs new-init-pairs)
   (cond
@@ -410,32 +376,42 @@
                                       mth-names mth-ctcs
                                       fld-names fld-ctcs
                                       init-names init-ctcs 
+                                      absent-methods absent-fields
                                       ctc-name internal-ctc)
-  (define ctc-hash
-    (make-hash (for/list ([raw-ctc (in-list mth-ctcs)]
-                          [name (in-list mth-names)])
+  (define (build-a-ctc-table names ctcs)
+    (make-hash (for/list ([raw-ctc (in-list ctcs)]
+                          [name (in-list names)])
                  (define ctc (if (just-check-existence? raw-ctc)
                                  raw-ctc
                                  (coerce-contract 'class/c raw-ctc)))
                  (cons name ctc))))
+  (define (build-a-proj-table hash names)
+    (make-hash
+     (for/list ([name (in-list names)])
+       (define ctc (hash-ref hash name))
+       (cond
+         [(just-check-existence? ctc)
+          (cons name ctc)]
+         [else
+          (define proj (get/build-val-first-projection ctc))
+          (cons name proj)]))))
+  (define mth-ctc-hash (build-a-ctc-table mth-names mth-ctcs))
+  (define fld-ctc-hash (build-a-ctc-table fld-names fld-ctcs))
+  (define mth-proj-hash (build-a-proj-table mth-ctc-hash mth-names))
+  (define fld-proj-hash (build-a-proj-table fld-ctc-hash fld-names))
   (ext-class/c-contract 
    opaque?
-   ctc-hash
-   (make-hash (for/list ([name (in-list mth-names)])
-                (define ctc (hash-ref ctc-hash name))
-                (cond
-                  [(just-check-existence? ctc)
-                   (cons name ctc)]
-                  [else
-                   (define proj (get/build-val-first-projection ctc))
-                   (cons name proj)])))
+   mth-ctc-hash mth-proj-hash
+   fld-ctc-hash fld-proj-hash
    (for/list ([name (in-list init-names)]
               [ctc (in-list init-ctcs)])
      (list name
            (if (just-check-existence? ctc)
                ctc
                (coerce-contract 'class/c ctc))))
-   ctc-name))
+   absent-methods absent-fields
+   ctc-name
+   internal-ctc))
 
 (define (class/c-first-order-passes? ctc cls)
   (cond
@@ -444,15 +420,26 @@
      (define mtd-vec (class-methods cls))
      (for/and ([(name ctc) (in-hash (ext-class/c-contract-table-of-meths-to-ctcs ctc))])
        (define mth-idx (hash-ref mth->idx name #f))
-       (and mth-idx
-            (contract-first-order-passes? ctc (vector-ref mtd-vec mth-idx))))]
+       (cond
+         [mth-idx
+          (define mth-record (vector-ref mtd-vec mth-idx))
+          (contract-first-order-passes? 
+           ctc 
+           (if (pair? mth-record)
+               (car mth-record)
+               mth-record))]
+         [else #f]))]
     [else #f]))
 
 (struct ext-class/c-contract (opaque?
                               table-of-meths-to-ctcs 
                               table-of-meths-to-projs
+                              table-of-flds-to-ctcs
+                              table-of-flds-to-projs
                               init-ctc-pairs
-                              name)
+                              absent-methods absent-fields
+                              name
+                              internal-ctc)
   #:property prop:contract
   (build-contract-property
    #:projection 
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index dcd3a1848b..5740f8e459 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -9,13 +9,14 @@
          (only-in "../contract/private/arrow.rkt" making-a-method method-contract?))
 
 (provide make-class/c class/c-proj
-         blame-add-method-context blame-add-init-context
+         blame-add-method-context blame-add-field-context blame-add-init-context
          class/c ->m ->*m ->dm case->m object/c instanceof/c
          make-wrapper-object
          check-object-contract
          (for-syntax parse-class/c-specs)
          (struct-out internal-class/c)
-         just-check-existence just-check-existence?)
+         just-check-existence just-check-existence?
+         build-internal-class/c internal-class/c-proj)
 
 (define undefined (letrec ([x x]) x))
 
@@ -153,7 +154,6 @@
 (define (class/c-external-proj ctc)
   (define ctc-methods (class/c-methods ctc))
   (λ (blame)
-    (define bswap (blame-swap blame))
     (define public-method-projections
       (for/list ([name (in-list ctc-methods)]
                  [c (in-list (class/c-method-contracts ctc))])
@@ -165,9 +165,9 @@
                  [c (in-list (class/c-field-contracts ctc))])
         (and c
              (let ([p-pos ((contract-projection c)
-                           (blame-add-context blame (format "the ~a field in" f)))]
+                           (blame-add-field-context blame f #:swap? #f))]
                    [p-neg ((contract-projection c)
-                           (blame-add-context bswap (format "the ~a field in" f)))])
+                           (blame-add-field-context blame f #:swap? #t))])
                (cons p-pos p-neg)))))
     
     ;; zip the inits and contracts together for ordered selection
@@ -307,7 +307,7 @@
               (define mp (vector-ref methods i))
               (vector-set! methods i (make-method (p mp) m)))))
         
-        ;; Handle both external field contracts
+        ;; Handle external field contracts
         (unless no-field-ctcs?
           (for ([f (in-list (class/c-fields ctc))]
                 [p-pr (in-list external-field-projections)])
@@ -724,6 +724,9 @@
      (blame-add-context blame "an unnamed method in")]
     [else (error 'blame-add-method-context "uhoh ~s" name)]))
 
+(define (blame-add-field-context blame f #:swap? swap?)
+  (blame-add-context blame (format "the ~a field in" f) #:swap? swap?))
+
 (define (build-internal-class/c inherits inherit-contracts inherit-fields inherit-field-contracts
                                 supers super-contracts inners inner-contracts
                                 overrides override-contracts augments augment-contracts
@@ -1161,9 +1164,12 @@
       (define new-cls (p (object-ref val)))
       (cond
         [(wrapped-class? new-cls)
+         (define the-info (wrapped-class-the-info new-cls))
          (wrapped-object
           val
-          (wrapped-class-info-neg-extra-arg-ht (wrapped-class-the-info new-cls))
+          (wrapped-class-info-neg-extra-arg-ht the-info)
+          (wrapped-class-info-pos-field-projs the-info)
+          (wrapped-class-info-neg-field-projs the-info)
           (wrapped-class-neg-party new-cls))]
         [else
          (impersonate-struct val object-ref (λ (o c) new-cls)
@@ -1303,11 +1309,9 @@
       (for ([f (in-list fields)]
             [c (in-list field-contracts)])
         (when c
-          (define fld-context (format "the ~a field in" f))
-          (define bset (blame-add-context blame fld-context #:swap? #t))
-          (let ([fi (hash-ref field-ht f)]
-                [p-pos ((contract-projection c) (blame-add-context blame fld-context))]
-                [p-neg ((contract-projection c) bset)])
-            (hash-set! field-ht f (field-info-extend-external fi p-pos p-neg))))))
+          (define fi (hash-ref field-ht f))
+          (define p-pos ((contract-projection c) (blame-add-field-context blame f #:swap? #f)))
+          (define p-neg ((contract-projection c) (blame-add-field-context blame f #:swap? #t)))
+          (hash-set! field-ht f (field-info-extend-external fi p-pos p-neg)))))
     
     c))
diff --git a/racket/collects/racket/private/class-internal.rkt b/racket/collects/racket/private/class-internal.rkt
index 6fbe3be6c1..43806586f5 100644
--- a/racket/collects/racket/private/class-internal.rkt
+++ b/racket/collects/racket/private/class-internal.rkt
@@ -3241,6 +3241,8 @@ An example
      (wrapped-object
       unwrapped-o
       (wrapped-class-info-neg-extra-arg-ht the-info)
+      (wrapped-class-info-pos-field-projs the-info)
+      (wrapped-class-info-neg-field-projs the-info)
       (wrapped-class-neg-party class))]
     [else
      (raise-argument-error 'instantiate "class?" class)]))
@@ -3763,22 +3765,43 @@ An example
   (do-set-field! 'set-field! id obj val))
 
 (define (do-set-field! who id obj val)
-  (unless (object? obj)
-    (raise-argument-error who
-                          "object?"
-                          obj))
-  (let* ([cls (object-ref/unwrap obj)]
-         [field-ht (class-field-ht cls)]
-         [fi (hash-ref field-ht id #f)])
-     (if fi
-         ((field-info-external-set! fi) obj val)
-         (obj-error who
-                    "given object does not have the requested field"
-                    "field name" (as-write id)
-                    "object" obj))))
+  (cond
+    [(_object? obj) 
+     (do-set-field!/raw-object who id obj val)]
+    [(wrapped-object? obj)
+     (define projs+set! (hash-ref (wrapped-object-neg-field-projs obj) id #f))
+     (cond
+       [projs+set! 
+        (define np (wrapped-object-neg-party obj))
+        (let loop ([projs+set! projs+set!]
+                   [val val])
+          (cond
+            [(pair? projs+set!)
+             (define the-proj (car projs+set!))
+             (loop (cdr projs+set!)
+                   ((the-proj val) np))]
+            [else
+             (projs+set! (wrapped-object-object obj) val)]))]
+       [else
+        (do-field-get/raw-object who id (wrapped-object-object obj))])]    
+    [else
+     (raise-argument-error who
+                           "object?"
+                           obj)]))
+
+(define (do-set-field!/raw-object who id obj val)
+  (define cls (object-ref obj))
+  (define field-ht (class-field-ht cls))
+  (define fi (hash-ref field-ht id #f))
+  (if fi
+      ((field-info-external-set! fi) obj val)
+      (obj-error who
+                 "given object does not have the requested field"
+                 "field name" (as-write id)
+                 "object" obj)))
 
 (define (dynamic-set-field! id obj val)
-  (unless (symbol? id) (raise-argument-error 'dynamic-get-field "symbol?" id))
+  (unless (symbol? id) (raise-argument-error 'dynamic-set-field! "symbol?" id))
   (do-set-field! 'dynamic-set-field! id obj val))
 
 (define-syntax (get-field stx)
@@ -3796,19 +3819,40 @@ An example
   (do-get-field 'get-field id obj))
 
 (define (do-get-field who id obj)
-  (unless (object? obj)
-    (raise-argument-error who
-                          "object?"
-                          obj))
-  (let* ([cls (object-ref/unwrap obj)]
-         [field-ht (class-field-ht cls)]
-         [fi (hash-ref field-ht id #f)])
-    (if fi
-        ((field-info-external-ref fi) obj)
-        (obj-error who
-                   "given object does not have the requested field"
-                   "field name" (as-write id)
-                   "object" obj))))
+  (cond
+    [(_object? obj)
+     (do-field-get/raw-object who id obj)]
+    [(wrapped-object? obj)
+     (define projs+ref (hash-ref (wrapped-object-pos-field-projs obj) id #f))
+     (cond
+       [projs+ref
+        (define np (wrapped-object-neg-party obj))
+        (let loop ([projs+ref projs+ref])
+          (cond
+            [(pair? projs+ref)
+             (define the-proj (car projs+ref))
+             (define field-val-with-other-contracts (loop (cdr projs+ref)))
+             ((the-proj field-val-with-other-contracts) np)]
+            [else
+             ;; projs+ref is the struct field accessor
+             (projs+ref (wrapped-object-object obj))]))]
+       [else
+        (do-field-get/raw-object who id (wrapped-object-object obj))])]
+    [else 
+     (raise-argument-error who
+                           "object?"
+                           obj)]))
+
+(define (do-field-get/raw-object who id obj)
+  (define cls (object-ref obj))
+  (define field-ht (class-field-ht cls))
+  (define fi (hash-ref field-ht id #f))
+  (if fi
+      ((field-info-external-ref fi) obj)
+      (obj-error who
+                 "given object does not have the requested field"
+                 "field name" (as-write id)
+                 "object" obj)))
 
 (define (dynamic-get-field id obj)
   (unless (symbol? id) (raise-argument-error 'dynamic-get-field "symbol?" id))
@@ -4170,7 +4214,10 @@ An example
 ;; runtime wrappers to support contracts with better space properties
 ;;--------------------------------------------------------------------
 
-(struct wrapped-class-info (class blame neg-extra-arg-ht neg-acceptors-ht init-proj-pairs)
+(struct wrapped-class-info (class blame 
+                             neg-extra-arg-ht neg-acceptors-ht 
+                             pos-field-projs neg-field-projs
+                             init-proj-pairs)
   #:transparent)
 (struct wrapped-class (the-info neg-party)
   #:property prop:custom-write
@@ -4183,7 +4230,8 @@ An example
       [(wrapped-class? class) (loop (wrapped-class-info-class (wrapped-class-the-info class)))]
       [else class])))
 
-(struct wrapped-object (object method-wrappers neg-party) #:transparent
+(struct wrapped-object (object method-wrappers pos-field-projs neg-field-projs neg-party)
+  #:transparent
   #:property prop:custom-write
   (λ (stct port mode)
     (do-custom-write (wrapped-object-object stct) port mode)))
@@ -4205,7 +4253,7 @@ An example
 
 (define (check-arg-contracts wrapped-blame wrapped-neg-party val init-proj-pairs orig-named-args)
   ;; blame will be #f only when init-ctc-pairs is '()
-  (define arg-blame (and wrapped-blame (blame-swap wrapped-blame))) 
+  (define arg-blame (and wrapped-blame (blame-swap wrapped-blame)))
   
   (define (missing-one init-ctc-pair)
     (raise-blame-error arg-blame #:missing-party wrapped-neg-party val
@@ -4487,6 +4535,9 @@ An example
          concretize-ictc-method field-info-extend-external field-info-extend-internal this-param
          object-ref/unwrap impersonator-prop:original-object has-original-object? original-object
          ;; end class-c-old.rkt requirements
+
+         field-info-internal-ref
+         field-info-internal-set!
          
          (rename-out [_class class]) class* class/derived
          define-serializable-class define-serializable-class*