diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
index fc68c37da1..21e59ec752 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
@@ -1460,4 +1460,30 @@
 
 ;; ----------------------------------------
 
+(let ()
+  (define f (lambda (x y #:z [z 1]) y))
+
+  (define same 
+    (make-keyword-procedure
+     (lambda (kws kw-args . args)
+       (if (null? kws)
+           (apply values args)
+           (apply values kw-args args)))))
+
+  (struct s2 (v) #:property prop:procedure 0)
+  (define f2 (s2 f))
+  (test #t chaperone-of? (chaperone-procedure f2 same) f2)
+  (test #t impersonator-of? (impersonate-procedure f2 same) f2)
+  (test 2 (lambda () ((chaperone-procedure f2 same) 1 2 #:z 3)))
+  (test 2 (chaperone-procedure f2 same) 1 2)
+
+  (struct s3 () #:property prop:procedure f)
+  (define f3 (s3))
+  (test #t chaperone-of? (chaperone-procedure f3 same) f3)
+  (test #t impersonator-of? (impersonate-procedure f3 same) f3)
+  (test 2 (lambda () ((chaperone-procedure f3 same) 2 #:z 3)))
+  (test 2 (chaperone-procedure f3 same) 2))
+
+;; ----------------------------------------
+
 (report-errs)
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl
index ffb8485b0e..d5c3ebf027 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl
@@ -9,6 +9,12 @@
 (define (f0+ . x) x)
 (define (f0+/drop1 . x) (cdr x))
 (define (f1 x) (list x))
+(define f1-m
+  (let-syntax ([m (lambda (stx)
+                    (syntax-property #'(lambda (x) (list x))
+                                     'method-arity-error
+                                     #t))])
+    m))
 (define (f1+ x . rest) (cons x rest))
 (define (f1+/drop1 x . rest) rest)
 (define (f0:a #:a a) (list a))
@@ -58,7 +64,7 @@
   (struct wrap-m ()
     #:property prop:procedure f)
   (wrap-m))
-                       
+
 (define procs
   `((,f0 0 () ())
     (,(wrap f0) 0 () ())
@@ -67,6 +73,7 @@
     (,(wrap-m f0+/drop1) ,(make-arity-at-least 0) () ())
     (,(wrap-m f1+/drop1) ,(make-arity-at-least 0) () ())
     (,f1 1 () ())
+    (,f1-m 1 () () #t)
     (,(procedure->method f1) 1 () () #t)
     (,(procedure->method (wrap f1)) 1 () () #t)
     (,(procedure->method (wrap f0+)) ,(make-arity-at-least 0) () () #t)
@@ -241,9 +248,7 @@
                              [(equal? allowed #f)
                               (err/rt-test ((car p) 1 #:a 1 #:b 1))])))))))
               (map
-               values ; add-chaperone
-               procs
-               #;
+               add-chaperone
                (append procs
                        ;; reduce to arity 1 or nothing:
                        (map (lambda (p)
diff --git a/racket/collects/racket/private/kw.rkt b/racket/collects/racket/private/kw.rkt
index a1cc812298..8072eaa5b2 100644
--- a/racket/collects/racket/private/kw.rkt
+++ b/racket/collects/racket/private/kw.rkt
@@ -159,10 +159,25 @@
                                     (current-inspector) fail-proc)])
       mk))
 
+  ;; Allows support for new-prop:procedure to extract a field (i.e., this property
+  ;; makes it possible to extract a field for an integer `new-prop:procedure` value):
+  (define-values (prop:procedure-accessor procedure-accessor? procedure-accessor-ref)
+    (make-struct-type-property 'procedure (lambda (v info-l)
+                                            (if (exact-integer? v)
+                                                (make-struct-field-accessor
+                                                 (list-ref info-l 3)
+                                                 v)
+                                                #f))))
+
   ;; Allows keyword application to see into a "method"-style procedure attribute:
   (define-values (new-prop:procedure new-procedure? new-procedure-ref)
     (make-struct-type-property 'procedure #f
-                               (list (cons prop:procedure values))))
+                               (list
+                                ;; Imply normal `prop:procedure`:
+                                (cons prop:procedure values)
+                                ;; Also imply `prop:procedure-accessor`, in case property
+                                ;; value is an integer:
+                                (cons prop:procedure-accessor values))))
 
   
   ;; Proxies
@@ -264,15 +279,15 @@
       (values (keyword-procedure-required p)
               (keyword-procedure-allowed p))]
      [(procedure? p)
-      (let ([p2 (procedure-extract-target p)])
-        (if p2
-            (procedure-keywords p2)
-            (if (new-procedure? p)
-                (let ([v (new-procedure-ref p)])
-                  (if (procedure? v)
-                      (procedure-keywords v)
-                      (values null null)))
-                (values null null))))]
+      (if (new-procedure? p)
+          (let ([v (new-procedure-ref p)])
+            (if (procedure? v)
+                (procedure-keywords v)
+                (let ([a (procedure-accessor-ref p)])
+                  (if a
+                      (procedure-keywords (a p))
+                      (values null null)))))
+          (values null null))]
      [else (raise-argument-error 'procedure-keywords
                                  "procedure?"
                                  p)]))
@@ -1239,7 +1254,11 @@
         ;; Not ok, so far:
         (let ([p2 (and (not (keyword-procedure? p))
                        (procedure? p)
-                       (or (procedure-extract-target p)
+                       (or (and (new-procedure? p)
+                                (let ([a (procedure-accessor-ref p)])
+                                  (and a
+                                       (a p))))
+                           (procedure-extract-target p) ; integer supplied to `make-struct-type`
                            (and (new-procedure? p) 'method)))])
           (if p2
               ;; Maybe the target is ok:
@@ -1420,7 +1439,10 @@
                  (raise-arguments-error 'procedure-reduce-arity
                                         "procedure has required keyword arguments"
                                         "procedure" proc)
-                 (procedure-reduce-arity proc arity)))])
+                 (procedure-reduce-arity (if (okm? proc)
+                                             (procedure->method proc)
+                                             proc)
+                                         arity)))])
       procedure-reduce-arity))
     
   (define new:procedure->method
@@ -1548,8 +1570,8 @@
                        [(kws args . rest)
                         (call-with-values (lambda () (apply p kws args rest))
                           (lambda results
-                            (let ([len (length results)]
-                                  [alen (length rest)])
+                            (let* ([len (length results)]
+                                   [alen (length rest)])
                               (unless (<= (+ alen 1) len (+ alen 2))
                                 (raise-arguments-error
                                  '|keyword procedure chaperone|
@@ -1593,45 +1615,78 @@
                        ;; bu this procedure's arity.
                        [other (error "shouldn't get here")]))]
                    [new-proc
-                    (cond
-                     [(okp? n-proc)
-                      (if is-impersonator?
-                          ((if (okm? n-proc)
-                               make-optional-keyword-method-impersonator
-                               make-optional-keyword-procedure-impersonator)
-                           (keyword-procedure-checker n-proc)
-                           (chaperone-procedure (keyword-procedure-proc n-proc)
-                                                kw-chaperone)
-                           (keyword-procedure-required n-proc)
-                           (keyword-procedure-allowed n-proc)
-                           (chaperone-procedure (okp-ref n-proc 0)
-                                                (okp-ref n-wrap-proc 0))
-                           n-proc)
+                    (let wrap ([proc proc] [n-proc n-proc])
+                      (cond
+                       [(and (not (eq? n-proc proc))
+                             (new-procedure? proc))
+                        (define v (new-procedure-ref proc))
+                        (cond
+                         [(exact-integer? v)
+                          ;; we have to chaperone the access to the field that
+                          ;; contains a procedure; the `new-procedure-accessor`
+                          ;; property gives us that accessor
                           (chaperone-struct
-                           n-proc
-                           keyword-procedure-proc
+                           proc
+                           (procedure-accessor-ref proc)
+                           (lambda (self sub-proc)
+                             (wrap sub-proc (normalize-proc sub-proc))))]
+                         [else
+                          (chaperone-struct
+                           proc
+                           new-procedure-ref
                            (lambda (self proc)
-                             (chaperone-procedure proc kw-chaperone))
-                           (make-struct-field-accessor okp-ref 0)
-                           (lambda (self proc)
-                             (chaperone-procedure proc
-                                                  (okp-ref n-wrap-proc 0)))))]
-                     [else
-                      (if is-impersonator?
-                          ;; Constructor must be from `make-required':
-                          (let* ([name+fail (keyword-procedure-name+fail n-proc)]
-                                 [mk (make-required (car name+fail) (cdr name+fail) (keyword-method? n-proc) #t)])
-                            (mk
+                             ;; This `proc` takes an extra argument, which is `self`:
+                             (chaperone-procedure
+                              proc
+                              (make-keyword-procedure 
+                               (lambda (kws kw-args self . args)
+                                 ;; Chain to `kw-chaperone', pulling out the self
+                                 ;; argument, and then putting it back:
+                                 (define len (length args))
+                                 (call-with-values
+                                     (lambda () (apply kw-chaperone kws kw-args args))
+                                   (lambda results
+                                     (if (= (length results) (add1 len))
+                                         (apply values (car results) self (cdr results))
+                                         (apply values (car results) (cadr results) self (cddr results))))))))))])]
+                       [(okp? n-proc)
+                        (if is-impersonator?
+                            ((if (okm? n-proc)
+                                 make-optional-keyword-method-impersonator
+                                 make-optional-keyword-procedure-impersonator)
                              (keyword-procedure-checker n-proc)
-                             (chaperone-procedure (keyword-procedure-proc n-proc) kw-chaperone)
+                             (chaperone-procedure (keyword-procedure-proc n-proc)
+                                                  kw-chaperone)
                              (keyword-procedure-required n-proc)
                              (keyword-procedure-allowed n-proc)
-                             n-proc))
-                          (chaperone-struct
-                           n-proc
-                           keyword-procedure-proc
-                           (lambda (self proc)
-                             (chaperone-procedure proc kw-chaperone))))])])
+                             (chaperone-procedure (okp-ref n-proc 0)
+                                                  (okp-ref n-wrap-proc 0))
+                             n-proc)
+                            (chaperone-struct
+                             proc
+                             keyword-procedure-proc
+                             (lambda (self proc)
+                               (chaperone-procedure proc kw-chaperone))
+                             (make-struct-field-accessor okp-ref 0)
+                             (lambda (self proc)
+                               (chaperone-procedure proc
+                                                    (okp-ref n-wrap-proc 0)))))]
+                       [else
+                        (if is-impersonator?
+                            ;; Constructor must be from `make-required':
+                            (let* ([name+fail (keyword-procedure-name+fail n-proc)]
+                                   [mk (make-required (car name+fail) (cdr name+fail) (keyword-method? n-proc) #t)])
+                              (mk
+                               (keyword-procedure-checker n-proc)
+                               (chaperone-procedure (keyword-procedure-proc n-proc) kw-chaperone)
+                               (keyword-procedure-required n-proc)
+                               (keyword-procedure-allowed n-proc)
+                               n-proc))
+                            (chaperone-struct
+                             n-proc
+                             keyword-procedure-proc
+                             (lambda (self proc)
+                               (chaperone-procedure proc kw-chaperone))))]))])
               (if (null? props)
                   new-proc
                   (apply chaperone-struct new-proc 
diff --git a/racket/collects/racket/trace.rkt b/racket/collects/racket/trace.rkt
index a8be5bee49..2ffaa0a826 100644
--- a/racket/collects/racket/trace.rkt
+++ b/racket/collects/racket/trace.rkt
@@ -177,7 +177,9 @@
 ;; A traced-proc struct instance acts like a procedure,
 ;;  but preserves the original, too.
 (define-values (struct:traced-proc make-traced-proc traced-proc? traced-proc-ref traced-proc-set!)
-  (make-struct-type 'traced-proc #f 2 0 #f null (current-inspector) 0))
+  (make-struct-type 'traced-proc #f 2 0 #f
+                    (list (cons prop:procedure 0))
+                    (current-inspector) #f (list 0 1)))
 
 ;; Install traced versions of a given set of procedures.  The traced
 ;;  versions are also given, so that they can be constructed to have
diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c
index 8d7096e4c0..d3a1921951 100644
--- a/racket/src/racket/src/fun.c
+++ b/racket/src/racket/src/fun.c
@@ -3067,9 +3067,43 @@ static int is_subarity(Scheme_Object *req, Scheme_Object *orig)
   return 1;
 }
 
+static int proc_is_method(Scheme_Object *proc)
+{
+  if (SCHEME_CHAPERONEP(proc))
+    proc = SCHEME_CHAPERONE_VAL(proc);
+
+  if (SCHEME_STRUCTP(proc)
+      && scheme_is_struct_instance(scheme_reduced_procedure_struct, proc))
+    return SCHEME_TRUEP(((Scheme_Structure *)proc)->slots[3]);
+
+  if (SAME_TYPE(SCHEME_TYPE(proc), scheme_case_closure_type)) {
+    Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)proc;
+    if (cl->count)
+      proc = cl->array[0];
+    else
+      return 0;
+  }
+
+  if (SAME_TYPE(SCHEME_TYPE(proc), scheme_closure_type)) {
+    return ((SCHEME_CLOSURE_DATA_FLAGS(SCHEME_COMPILED_CLOS_CODE(proc)) & CLOS_IS_METHOD)
+            ? 1
+            : 0);
+  }
+
+#ifdef MZ_USE_JIT
+  if (SAME_TYPE(SCHEME_TYPE(proc), scheme_native_closure_type)) {
+    Scheme_Object *pa;
+    pa = scheme_get_native_arity(proc, -1);
+    return SCHEME_BOXP(pa);
+  }
+#endif
+
+  return 0;
+}
+
 static Scheme_Object *procedure_reduce_arity(int argc, Scheme_Object *argv[])
 {
-  Scheme_Object *orig, *aty;
+  Scheme_Object *orig, *aty, *is_meth = NULL;
 
   if (!SCHEME_PROCP(argv[0]))
     scheme_wrong_contract("procedure-reduce-arity", "procedure?", 0, argc, argv);
@@ -3096,8 +3130,11 @@ static Scheme_Object *procedure_reduce_arity(int argc, Scheme_Object *argv[])
     return NULL;
   }
 
+  if (proc_is_method(argv[0]))
+    is_meth = scheme_true;
+
   /* Construct a procedure that has the given arity. */
-  return make_reduced_proc(argv[0], aty, NULL, NULL);
+  return make_reduced_proc(argv[0], aty, NULL, is_meth);
 }
 
 static Scheme_Object *procedure_rename(int argc, Scheme_Object *argv[])
diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c
index c86413dc82..6b3f8252e6 100644
--- a/racket/src/racket/src/struct.c
+++ b/racket/src/racket/src/struct.c
@@ -4382,6 +4382,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
 
       /* Add new props: */
       for (l = props; SCHEME_PAIRP(l); ) {
+        int skip_supers = 0;
+
 	a = SCHEME_CAR(l);
 	prop = SCHEME_CAR(a);
 
@@ -4400,6 +4402,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
             if (!scheme_hash_get(can_override, prop)) {
               if (!SAME_OBJ(oldv, propv))
                 break;
+              skip_supers = 1;
             }
             /* otherwise we override */
             scheme_hash_set(can_override, prop, NULL);
@@ -4407,7 +4410,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
         }
         
         l = SCHEME_CDR(l);
-        l = append_super_props((Scheme_Struct_Property *)prop, propv, l);
+        if (!skip_supers)
+          l = append_super_props((Scheme_Struct_Property *)prop, propv, l);
         
         if (SAME_OBJ(prop, proc_property))
           proc_prop_set = propv;
@@ -4434,6 +4438,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
       num_props = i;
 
       for (l = props; SCHEME_PAIRP(l); ) {
+        int skip_supers = 0;
+
 	a = SCHEME_CAR(l);
 
 	prop = SCHEME_CAR(a);
@@ -4457,7 +4463,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
             /* already there */
             if (!scheme_hash_get(can_override, prop)) {
               if (!SAME_OBJ(propv, SCHEME_CDR(pa[j])))
-                break; 
+                break;
+              skip_supers = 1;
             }
             /* overriding it: */
             scheme_hash_set(can_override, prop, NULL);
@@ -4466,7 +4473,8 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
         }
         
         l = SCHEME_CDR(l);
-        l = append_super_props((Scheme_Struct_Property *)prop, propv, l);
+        if (!skip_supers)
+          l = append_super_props((Scheme_Struct_Property *)prop, propv, l);
         
         if (SAME_OBJ(prop, proc_property))
           proc_prop_set = propv;