diff --git a/pkgs/racket-test/tests/racket/contract/arrow.rkt b/pkgs/racket-test/tests/racket/contract/arrow.rkt
index b5d5ce0a99..6f17db0274 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow.rkt
@@ -611,5 +611,33 @@
           (begin (set! l (cons 6 l)) #f))
       (reverse l))
    '(1 2 3 4 5 6))
-  
+
+  (contract-error-test
+   '->-arity-error1
+   '(contract
+     (-> any/c any/c)
+     (lambda (x y) #t)
+     'pos 'neg)
+   (lambda (e)
+     (regexp-match? "a procedure that accepts 1 non-keyword argument"
+                    (exn-message e))))
+  (contract-error-test
+   '->-arity-error2
+   '(contract
+     (-> any/c)
+     (lambda (x y) #t)
+     'pos 'neg)
+   (lambda (e)
+     (regexp-match? "a procedure that accepts 0 non-keyword argument"
+                    (exn-message e))))
+  (contract-error-test
+   '->-arity-error3
+   '(contract
+     (->* (any/c) (#:x any/c) any/c)
+     (lambda (x) #t)
+     'pos 'neg)
+   (lambda (e)
+     (regexp-match? "a procedure that accepts the #:x keyword argument"
+                    (exn-message e))))
+
   )
diff --git a/pkgs/racket-test/tests/racket/contract/class.rkt b/pkgs/racket-test/tests/racket/contract/class.rkt
index e1f74313c4..327090a6ed 100644
--- a/pkgs/racket-test/tests/racket/contract/class.rkt
+++ b/pkgs/racket-test/tests/racket/contract/class.rkt
@@ -2615,4 +2615,33 @@
                       (init-field [x 0]))
                     'pos 'neg)])
       (equal? (new c%) (new c%)))
-   #f))
+   #f)
+
+  (contract-error-test
+   '->m-arity-error-1
+   '(contract (->m string? string?)
+              (lambda (y) y)
+              'pos
+              'neg)
+   (lambda (e)
+     (regexp-match? "a method that accepts 1 non-keyword argument"
+                    (exn-message e))))
+  (contract-error-test
+   '->m-arity-error-2
+   '(contract (->m string?)
+              (lambda () y)
+              'pos
+              'neg)
+   (lambda (e)
+     (regexp-match? "a method that accepts 0 non-keyword argument"
+                    (exn-message e))))
+  (contract-error-test
+   '->m-arity-error3
+   '(contract (->*m (any/c) (#:x any/c) any/c)
+              (lambda (x y) #t)
+              'pos
+              'neg)
+   (lambda (e)
+     (regexp-match? "a method that accepts the #:x keyword argument"
+                    (exn-message e))))
+  )
diff --git a/pkgs/racket-test/tests/racket/contract/prof.rkt b/pkgs/racket-test/tests/racket/contract/prof.rkt
index 535489ccea..31d048d5af 100644
--- a/pkgs/racket-test/tests/racket/contract/prof.rkt
+++ b/pkgs/racket-test/tests/racket/contract/prof.rkt
@@ -369,7 +369,7 @@
    '(let ()
       (define o
         (contract
-         (object-contract (field x pos-blame?) (f (->m neg-blame?)))
+         (object-contract (field x pos-blame?) (f (-> neg-blame?)))
          (new (class object% (init-field x) (define/public (f) x) (super-new)) [x 3])
          'pos 'neg))
       (get-field x o)
diff --git a/racket/collects/racket/contract/base.rkt b/racket/collects/racket/contract/base.rkt
index d2b97e703e..6b5a21df41 100644
--- a/racket/collects/racket/contract/base.rkt
+++ b/racket/collects/racket/contract/base.rkt
@@ -16,7 +16,7 @@
          "private/basic-opters.rkt" ;; required for effect to install the opters
          "private/opt.rkt"
          "private/out.rkt"
-         "private/arrow-val-first.rkt"
+         (except-in "private/arrow-val-first.rkt" base->?)
          "private/orc.rkt"
          "private/list.rkt"
          "private/and.rkt")
diff --git a/racket/collects/racket/contract/private/arity-checking.rkt b/racket/collects/racket/contract/private/arity-checking.rkt
index fadeab0f72..39cf685dd6 100644
--- a/racket/collects/racket/contract/private/arity-checking.rkt
+++ b/racket/collects/racket/contract/private/arity-checking.rkt
@@ -13,13 +13,16 @@
                            ->stct-doms
                            ->stct-rest
                            ->stct-min-arity
-                           ->stct-kwd-infos)
+                           ->stct-kwd-infos
+                           method?)
+  (define proc/meth (if method? "a method" "a procedure"))
   (let/ec k
     (unless (procedure? val)
       (k
        (λ (neg-party)
          (raise-blame-error blame #:missing-party neg-party val
-                            '(expected: "a procedure" given: "~e")
+                            `(expected: ,proc/meth
+                                        given: "~e")
                             val))))
      (define-values (actual-mandatory-kwds actual-optional-kwds) (procedure-keywords val))
      (define arity (if (list? (procedure-arity val))
@@ -46,13 +49,17 @@
        (unless matching-arity?
          (k
           (λ (neg-party)
+            (define expected-number-of-non-keyword-args*
+              ((if method? sub1 values) expected-number-of-non-keyword-args))
             (raise-blame-error blame #:missing-party neg-party val
-                               '(expected:
-                                 "a procedure that accepts ~a non-keyword argument~a~a"
+                               `(expected:
+                                 ,(string-append "a "
+                                                 proc/meth
+                                                 " that accepts ~a non-keyword argument~a~a")
                                  given: "~e"
                                  "\n  ~a")
-                               expected-number-of-non-keyword-args
-                               (if (= expected-number-of-non-keyword-args 1) "" "s")
+                               expected-number-of-non-keyword-args*
+                               (if (= expected-number-of-non-keyword-args* 1) "" "s")
                                (if ->stct-rest
                                    " and arbitrarily many more"
                                    "")
@@ -63,25 +70,25 @@
       (k
        (λ (neg-party)
          (raise-blame-error blame #:missing-party neg-party val
-                            '(expected: 
-                              "a procedure that accepts the ~a keyword argument"
+                            `(expected: 
+                              ,(string-append proc/meth " that accepts the ~a keyword argument")
                               given: "~e"
                               "\n  ~a")
                             kwd
                             val
-                            (arity-as-string val)))))
+                            (arity-as-string val method?)))))
     
     (define (should-not-have-supplied kwd)
       (k
        (λ (neg-party)
          (raise-blame-error blame #:missing-party neg-party val
-                            '(expected: 
-                              "a procedure that does not require the ~a keyword argument"
+                            `(expected: 
+                              ,(string-append proc/meth " that does not require the ~a keyword argument")
                               given: "~e"
                               "\n  ~a")
                             kwd
                             val
-                            (arity-as-string val)))))
+                            (arity-as-string val method?)))))
     
     (when actual-optional-kwds ;; when all kwds are okay, no checking required
       (let loop ([mandatory-kwds actual-mandatory-kwds]
@@ -115,13 +122,13 @@
                  (λ (neg-party)
                    (raise-blame-error 
                     blame #:missing-party neg-party val
-                    '(expected:
-                      "a procedure that optionally accepts the keyword ~a (this one is mandatory)"
+                    `(expected:
+                      ,(string-append proc/meth " that optionally accepts the keyword ~a (this one is mandatory)")
                       given: "~e"
                       "\n  ~a")
                     val
                     kwd
-                    (arity-as-string val)))))
+                    (arity-as-string val method?)))))
               (loop new-mandatory-kwds new-all-kwds (cdr kwd-infos))]
              [(keyword<? kwd (kwd-info-kwd kwd-info))
               (when mandatory?
@@ -133,14 +140,15 @@
     #f))
 
 
-(define (arity-as-string v)
+(define (arity-as-string v [method? #f])
   (define prefix (if (object-name v)
                      (format "~a accepts: " (object-name v))
                      (format "accepts: ")))
-  (string-append prefix (raw-arity-as-string v)))
+  (string-append prefix (raw-arity-as-string v method?)))
 
-(define (raw-arity-as-string v)
+(define (raw-arity-as-string v [method? #f])
   (define ar (procedure-arity v))
+  (define adjust (if method? sub1 values))
   (define (plural n) (if (= n 1) "" "s"))
   (define-values (man-kwds all-kwds) (procedure-keywords v))
   (define opt-kwds (if all-kwds (remove* man-kwds all-kwds) #f))
@@ -148,9 +156,11 @@
   (define normal-args
     (cond
       [(null? ar) "no arguments"]
-      [(number? ar) (format "~a ~aargument~a" ar normal-str (plural ar))]
+      [(number? ar)
+       (define ar* (adjust ar))
+       (format "~a ~aargument~a" ar* normal-str (plural ar*))]
       [(arity-at-least? ar) (format "~a or arbitrarily many more ~aarguments"
-                                    (arity-at-least-value ar)
+                                    (adjust (arity-at-least-value ar))
                                     normal-str)]
       [else
        (define comma
@@ -168,12 +178,12 @@
                [(arity-at-least? v)
                 (list
                  (format "~a, or arbitrarily many more ~aarguments" 
-                         (arity-at-least-value v)
+                         (arity-at-least-value (adjust v))
                          normal-str))]
                [else
-                (list (format "or ~a ~aarguments" v normal-str))])]
+                (list (format "or ~a ~aarguments" (adjust v) normal-str))])]
             [else 
-             (cons (format "~a~a " (car ar) comma)
+             (cons (format "~a~a " (adjust (car ar)) comma)
                    (loop (cdr ar)))])))]))
   (cond
     [(and (null? man-kwds) (null? opt-kwds)) 
diff --git a/racket/collects/racket/contract/private/arrow-higher-order.rkt b/racket/collects/racket/contract/private/arrow-higher-order.rkt
index fae0ce4b94..8c6f90d918 100644
--- a/racket/collects/racket/contract/private/arrow-higher-order.rkt
+++ b/racket/collects/racket/contract/private/arrow-higher-order.rkt
@@ -19,11 +19,10 @@
          ->-proj
          check-pre-cond
          check-post-cond
-         pre-post/desc-result->string)
+         pre-post/desc-result->string
+         raise-wrong-number-of-args-error)
 
-(define-for-syntax (build-chaperone-constructor/real this-args
-
-                                                     ;; (listof (or/c #f stx))
+(define-for-syntax (build-chaperone-constructor/real ;; (listof (or/c #f stx))
                                                      ;; #f => syntactically known to be any/c
                                                      mandatory-dom-projs
                                                      
@@ -33,7 +32,8 @@
                                                      pre pre/desc
                                                      rest
                                                      rngs
-                                                     post post/desc)
+                                                     post post/desc
+                                                     method?)
   (define (nvars n sym) (generate-temporaries (for/list ([i (in-range n)]) sym)))
   (with-syntax ([(mandatory-dom-proj ...) (generate-temporaries mandatory-dom-projs)]
                 [(optional-dom-proj ...) (generate-temporaries optional-dom-projs)]
@@ -51,7 +51,6 @@
         (define blame+neg-party (cons blame neg-party))
         #,(create-chaperone
            #'blame #'neg-party #'blame+neg-party #'blame-party-info #'f #'rng-ctcs
-           this-args
            (for/list ([id (in-list (syntax->list #'(mandatory-dom-proj ...)))]
                       [mandatory-dom-proj (in-list mandatory-dom-projs)])
              (and mandatory-dom-proj id))
@@ -65,7 +64,8 @@
            pre pre/desc
            (if rest (car (syntax->list #'(rest-proj ...))) #f)
            (if rngs (syntax->list #'(rng-proj ...)) #f)
-           post post/desc))))
+           post post/desc
+           method?))))
 
 
 (define (check-pre-cond pre blame neg-party blame+neg-party val)
@@ -128,13 +128,13 @@
 
 (define-for-syntax (create-chaperone blame neg-party blame+neg-party blame-party-info
                                      val rng-ctcs
-                                     this-args
                                      doms opt-doms
                                      req-kwds opt-kwds
                                      pre pre/desc
                                      dom-rest
                                      rngs
-                                     post post/desc)
+                                     post post/desc
+                                     method?)
   (with-syntax ([blame blame]
                 [blame+neg-party blame+neg-party]
                 [val val])
@@ -152,8 +152,7 @@
                      [post/desc
                       (list #`(check-post-cond/desc #,post/desc blame neg-party val))]
                      [else null])])
-      (with-syntax ([(this-param ...) this-args]
-                    [(dom-x ...) (generate-temporaries doms)]
+      (with-syntax ([(dom-x ...) (generate-temporaries doms)]
                     [(opt-dom-ctc ...) opt-doms]
                     [(opt-dom-x ...) (generate-temporaries opt-doms)]
                     [(rest-ctc rest-x) (cons dom-rest (generate-temporaries '(rest)))]
@@ -194,9 +193,7 @@
                      #,rng-checker))
               stx))
 
-          (let* ([min-method-arity (length doms)]
-                 [max-method-arity (+ min-method-arity (length opt-doms))]
-                 [min-arity (+ (length this-args) min-method-arity)]
+          (let* ([min-arity (length doms)]
                  [max-arity (+ min-arity (length opt-doms))]
                  [req-keywords (map (λ (p) (syntax-e (car p))) req-kwds)]
                  [opt-keywords (map (λ (p) (syntax-e (car p))) opt-kwds)]
@@ -210,13 +207,12 @@
                           [basic-params
                            (cond
                              [dom-rest
-                              #'(this-param ... 
-                                 dom-x ...
+                              #'(dom-x ...
                                  [opt-dom-x arrow:unspecified-dom] ...
                                  . 
                                  rest-x)]
                              [else
-                              #'(this-param ... dom-x ... [opt-dom-x arrow:unspecified-dom] ...)])]
+                              #'(dom-x ... [opt-dom-x arrow:unspecified-dom] ...)])]
                           [opt+rest-uses
                            (for/fold ([i (if dom-rest #'(rest-ctc rest-x neg-party) #'null)])
                              ([o (in-list (reverse
@@ -252,24 +248,20 @@
               
               (with-syntax ([kwd-lam-params
                              (if dom-rest
-                                 #'(this-param ...
-                                    dom-x ... 
+                                 #'(dom-x ... 
                                     [opt-dom-x arrow:unspecified-dom] ...
                                     kwd-param ... . rest-x)
-                                 #'(this-param ...
-                                    dom-x ...
+                                 #'(dom-x ...
                                     [opt-dom-x arrow:unspecified-dom] ...
                                     kwd-param ...))]
                             [basic-return
                              (let ([inner-stx-gen
                                     (if need-apply?
                                         (λ (s) #`(apply values #,@s 
-                                                        this-param ... 
                                                         dom-projd-args ... 
                                                         opt+rest-uses))
                                         (λ (s) #`(values 
                                                   #,@s 
-                                                  this-param ...
                                                   dom-projd-args ...)))])
                                (if rngs
                                    (arrow:check-tail-contract rng-ctcs
@@ -286,8 +278,8 @@
                                (define (inner-stx-gen stuff assume-result-values? do-tail-check?)
                                  (define arg-checking-expressions
                                    (if need-apply?
-                                       #'(this-param ... dom-projd-args ... opt+rest-uses)
-                                       #'(this-param ... dom-projd-args ...)))
+                                       #'(dom-projd-args ... opt+rest-uses)
+                                       #'(dom-projd-args ...)))
                                  (define the-call/no-tail-mark
                                    (cond
                                      [(for/and ([dom (in-list doms)])
@@ -336,11 +328,9 @@
                                      (if need-apply?
                                          (λ (s k) #`(apply values 
                                                            #,@s #,@k 
-                                                           this-param ...
                                                            dom-projd-args ...
                                                            opt+rest-uses))
                                          (λ (s k) #`(values #,@s #,@k 
-                                                            this-param ...
                                                             dom-projd-args ...)))]
                                     [outer-stx-gen
                                      (if (null? req-keywords)
@@ -393,43 +383,163 @@
                                                (let ()
                                                  pre ... kwd-return)))])
                   (cond
-                    [(and (null? req-keywords) (null? opt-keywords))
-                     #`(arrow:arity-checking-wrapper val 
-                                                     blame neg-party blame+neg-party
-                                                     basic-lambda
-                                                     basic-unsafe-lambda
-                                                     basic-unsafe-lambda/result-values-assumed
-                                                     basic-unsafe-lambda/result-values-assumed/no-tail
-                                                     #,(and rngs (length rngs))
-                                                     void
-                                                     #,min-method-arity
-                                                     #,max-method-arity
-                                                     #,min-arity
-                                                     #,(if dom-rest #f max-arity)
-                                                     '(req-kwd ...)
-                                                     '(opt-kwd ...))]
-                    [(pair? req-keywords)
-                     #`(arrow:arity-checking-wrapper val
-                                                     blame neg-party blame+neg-party
-                                                     void #t #f #f #f
-                                                     kwd-lambda
-                                                     #,min-method-arity
-                                                     #,max-method-arity
-                                                     #,min-arity
-                                                     #,(if dom-rest #f max-arity)
-                                                     '(req-kwd ...)
-                                                     '(opt-kwd ...))]
-                    [else
-                     #`(arrow:arity-checking-wrapper val 
-                                                     blame neg-party blame+neg-party
-                                                     basic-lambda #t #f #f #f
-                                                     kwd-lambda
-                                                     #,min-method-arity
-                                                     #,max-method-arity
-                                                     #,min-arity
-                                                     #,(if dom-rest #f max-arity)
-                                                     '(req-kwd ...)
-                                                     '(opt-kwd ...))])))))))))
+                   [(and (null? req-keywords) (null? opt-keywords))
+                    #`(arity-checking-wrapper val
+                                              blame neg-party blame+neg-party
+                                              basic-lambda
+                                              basic-unsafe-lambda
+                                              basic-unsafe-lambda/result-values-assumed
+                                              basic-unsafe-lambda/result-values-assumed/no-tail
+                                              #,(and rngs (length rngs))
+                                              void
+                                              #,min-arity
+                                              #,(if dom-rest #f max-arity)
+                                              '(req-kwd ...)
+                                              '(opt-kwd ...)
+                                              #,method?)]
+                   [(pair? req-keywords)
+                    #`(arity-checking-wrapper val
+                                              blame neg-party blame+neg-party
+                                              void #t #f #f #f
+                                              kwd-lambda
+                                              #,min-arity
+                                              #,(if dom-rest #f max-arity)
+                                              '(req-kwd ...)
+                                              '(opt-kwd ...)
+                                              #,method?)]
+                   [else
+                    #`(arity-checking-wrapper val
+                                              blame neg-party blame+neg-party
+                                              basic-lambda #t #f #f #f
+                                              kwd-lambda
+                                              #,min-arity
+                                              #,(if dom-rest #f max-arity)
+                                              '(req-kwd ...)
+                                              '(opt-kwd ...)
+                                              #,method?)])))))))))
+
+;; should we pass both the basic-lambda and the kwd-lambda?
+;; if basic-unsafe-lambda is #f, returns only the one value,
+;; namely the chaperone wrapper. Otherwise, returns two values,
+;; a procedure and a boolean indicating it the procedure is the
+;; basic-unsafe-lambda or not; note that basic-unsafe-lambda might
+;; also be #t, but that happens only when we know that basic-lambda
+;; can't be chosen (because there are keywords involved)
+(define (arity-checking-wrapper val blame neg-party blame+neg-party basic-lambda
+                                basic-unsafe-lambda
+                                basic-unsafe-lambda/result-values-assumed
+                                basic-unsafe-lambda/result-values-assumed/no-tail
+                                contract-result-val-count
+                                kwd-lambda
+                                min-arity max-arity
+                                req-kwd opt-kwd
+                                method?)
+  ;; should not build this unless we are in the 'else' case (and maybe not at all)
+  (cond
+    [(arrow:matches-arity-exactly? val min-arity max-arity req-kwd opt-kwd)
+     (if (and (null? req-kwd) (null? opt-kwd))
+         (cond
+           [(impersonator? val)
+            (if basic-unsafe-lambda
+                (values basic-lambda #f)
+                basic-lambda)]
+           [(and basic-unsafe-lambda
+                 basic-unsafe-lambda/result-values-assumed
+                 (equal? contract-result-val-count
+                         (procedure-result-arity val)))
+            (if (simple-enough? val)
+                (values basic-unsafe-lambda/result-values-assumed/no-tail #t)
+                (values basic-unsafe-lambda/result-values-assumed #t))]
+           [basic-unsafe-lambda
+            (values basic-unsafe-lambda #t)]
+           [else basic-lambda])
+         (if basic-unsafe-lambda
+             (values kwd-lambda #f)
+             kwd-lambda))]
+    [else
+     (define-values (vr va) (procedure-keywords val))
+     (define all-kwds (append req-kwd opt-kwd))
+     (define (valid-number-of-args? args)
+       (if max-arity
+           (<= min-arity (length args) max-arity)
+           (<= min-arity (length args))))
+     (define kwd-checker
+       (if (and (null? req-kwd) (null? opt-kwd))
+           (λ (kwds kwd-args . args)
+             (arrow:raise-no-keywords-arg blame #:missing-party neg-party val kwds))
+           (λ (kwds kwd-args . args)
+             (with-contract-continuation-mark
+              blame+neg-party
+              (let ()
+             (define args-len (length args))
+             (unless (valid-number-of-args? args)
+               (raise-wrong-number-of-args-error
+                blame #:missing-party neg-party val
+                args-len min-arity max-arity method?))
+
+             ;; these two for loops are doing O(n^2) work that could be linear
+             ;; (since the keyword lists are sorted)
+             (for ([req-kwd (in-list req-kwd)])
+               (unless (memq req-kwd kwds)
+                 (raise-blame-error (blame-swap blame) #:missing-party neg-party
+                                    val
+                                    '(expected "keyword argument ~a")
+                                    req-kwd)))
+             (for ([k (in-list kwds)])
+               (unless (memq k all-kwds)
+                 (raise-blame-error (blame-swap blame) #:missing-party neg-party val
+                                    '(received: "unexpected keyword argument ~a")
+                                    k)))
+             (keyword-apply kwd-lambda kwds kwd-args args))))))
+     (define basic-checker-name
+       (if (null? req-kwd)
+           (λ args
+             (with-contract-continuation-mark
+              blame+neg-party
+              (let ()
+             (unless (valid-number-of-args? args)
+               (define args-len (length args))
+               (raise-wrong-number-of-args-error
+                blame #:missing-party neg-party val
+                args-len min-arity max-arity method?))
+             (apply basic-lambda args))))
+           (λ args
+             (raise-blame-error (blame-swap blame) #:missing-party neg-party val
+                                "expected required keyword ~a"
+                                (car req-kwd)))))
+     (define proc
+       (if (or (not va) (pair? vr) (pair? va))
+           (make-keyword-procedure kwd-checker basic-checker-name)
+           basic-checker-name))
+     (if basic-unsafe-lambda
+         (values proc #f)
+         proc)]))
+
+(define (simple-enough? f)
+  (or (struct-accessor-procedure? f)
+      (struct-constructor-procedure? f)
+      (struct-predicate-procedure? f)
+      (struct-mutator-procedure? f)))
+
+(define (raise-wrong-number-of-args-error
+         blame #:missing-party [missing-party #f] val
+         args-len pre-min-arity pre-max-arity method?)
+  (define min-arity ((if method? sub1 values) pre-min-arity))
+  (define max-arity ((if method? sub1 values) pre-max-arity))
+  (define arity-string
+    (if max-arity
+        (cond
+          [(= min-arity max-arity)
+           (format "~a non-keyword argument~a" min-arity (if (= min-arity 1) "" "s"))]
+          [(= (+ min-arity 1) max-arity)
+           (format "~a or ~a non-keyword arguments" min-arity max-arity)]
+          [else
+           (format "~a to ~a non-keyword arguments" min-arity max-arity)])
+        (format "at least ~a non-keyword argument~a" min-arity (if (= min-arity 1) "" "s"))))
+  (raise-blame-error (blame-swap blame) val
+                     #:missing-party missing-party
+                     '(received: "~a argument~a" expected: "~a")
+                     args-len (if (= args-len 1) "" "s") arity-string))
 
 (define (maybe-cons-kwd c x r neg-party)
   (if (eq? arrow:unspecified-dom x)
@@ -439,7 +549,7 @@
 (define (->-proj chaperone? ctc
                  ;; fields of the 'ctc' struct
                  min-arity doms kwd-infos rest pre? rngs post?
-                 plus-one-arity-function chaperone-constructor
+                 plus-one-arity-function chaperone-constructor method?
                  late-neg?)
   (define optionals-length (- (length doms) min-arity))
   (define mtd? #f) ;; not yet supported for the new contracts
@@ -460,7 +570,7 @@
                  [n (in-naturals 1)])
         ((get/build-late-neg-projection dom)
          (blame-add-context orig-blame 
-                            (format "the ~a argument of" (n->th n))
+                            (format "the ~a argument of" (n->th (if method? (sub1 n) n)))
                             #:swap? #t))))
     (define rest-blame
       (if (ellipsis-rest-arg-ctc? rest)
@@ -532,7 +642,7 @@
       [late-neg?
        (define (arrow-higher-order:lnp val neg-party)
          (cond
-           [(do-arity-checking orig-blame val doms rest min-arity kwd-infos)
+           [(do-arity-checking orig-blame val doms rest min-arity kwd-infos method?)
             =>
             (λ (f)
               (f neg-party))]
@@ -549,7 +659,7 @@
          (define-values (normal-proc proc-with-no-result-checking expected-number-of-results)
            (apply plus-one-arity-function orig-blame val plus-one-constructor-args))
          (cond
-           [(do-arity-checking orig-blame val doms rest min-arity kwd-infos)
+           [(do-arity-checking orig-blame val doms rest min-arity kwd-infos method?)
             =>
             (λ (neg-party-acceptor)
               ;; probably don't need to include the wrapped-extra-arrow wrapper
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index 583ff84663..effb04dd58 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -14,34 +14,20 @@
          (prefix-in arrow: "arrow.rkt"))
 
 (provide ->2 ->*2
+         ->2-internal ->*2-internal ; for ->m and ->*m
+         base->? base->-name ; for object-contract
          dynamic->*
-         (for-syntax ->2-handled?
-                     ->2-arity-check-only->?
-                     ->*2-handled?
+         (for-syntax ->2-arity-check-only->?
                      ->2*-arity-check-only->?
                      ->-valid-app-shapes
                      ->*-valid-app-shapes)
          (rename-out [-predicate/c predicate/c]))
 
-(define-for-syntax (->2-handled? stx)
-  (syntax-case stx (any values any/c boolean?)
-    [(_ args ...)
-     (syntax-parameter-value #'arrow:making-a-method)
-     #f]
-    [_ #t]))
-
 (define-for-syntax (->2-arity-check-only->? stx)
   (syntax-case stx (any any/c)
     [(_ any/c ... any) (- (length (syntax->list stx)) 2)]
     [_ #f]))
 
-(define-for-syntax (->*2-handled? stx)
-  (syntax-case stx (any values any/c)
-    [(_ args ...)
-     (syntax-parameter-value #'arrow:making-a-method)
-     #f]
-    [_ #t]))
-
 (define-for-syntax (->2*-arity-check-only->? stx)
   (syntax-case stx (any any/c)
     [(_ (any/c ...) any) (length (syntax->list (cadr (syntax->list stx))))]
@@ -106,14 +92,19 @@
 (generate-popular-key-ids popular-key-ids)
 
 (define-for-syntax (build-plus-one-arity-function+chaperone-constructor
-                    regular-args
+                    pre-regular-args
                     optional-args
                     mandatory-kwds
                     optional-kwds
                     pre pre/desc
                     rest
                     rngs
-                    post post/desc)
+                    post post/desc
+                    method?)
+  (define regular-args
+    (if method?
+        (cons #'any/c pre-regular-args) ; add `this` argument
+        pre-regular-args))
   (define regular-args/no-any/c
     (for/list ([stx (in-list regular-args)])
       (syntax-case stx (any/c)
@@ -145,9 +136,9 @@
               pre pre/desc
               rest
               rngs
-              post post/desc)
+              post post/desc
+              method?)
              (build-chaperone-constructor/real
-              '() ;; this-args 
               regular-args/no-any/c
               optional-args
               mandatory-kwds
@@ -155,7 +146,8 @@
               pre pre/desc
               rest
               rngs
-              post post/desc))]))
+              post post/desc
+              method?))]))
 
 (define-syntax (build-populars stx)
   (syntax-case stx ()
@@ -192,17 +184,16 @@
                        #f #f
                        rest
                        rng-vars
-                       #f #f))
+                       #f #f #f))
                   (define #,(syntax-local-introduce chaperone-id)
                     #,(let ([ans (build-chaperone-constructor/real
-                                  '() ;; this arg
                                   mans/no-any/c opts
                                   mandatory-kwds
                                   optional-kwds
                                   #f #f
                                   rest
                                   rng-vars
-                                  #f #f)])
+                                  #f #f #f)])
                         #;
                         (when (equal? key (list '(#t) 0 '() '() #f 1))
                           ((dynamic-require 'racket/pretty 'pretty-write) (syntax->datum ans))
@@ -222,7 +213,8 @@
                     pre pre/desc
                     rest
                     rngs
-                    post post/desc)
+                    post post/desc
+                    method?)
   (with-syntax ([(regb ...) (generate-temporaries regular-args)]
                 [(optb ...) (generate-temporaries optional-args)]
                 [(kb ...) (generate-temporaries mandatory-kwds)]
@@ -369,10 +361,11 @@
                                    #,(if pre pre #'#f)
                                    '(#,@mandatory-kwds) (list kb ...)
                                    '(#,@optional-kwds) (list okb ...) 
-                                   #,(length regular-args) (list regb ... optb ...) 
+                                   #,(length regular-args) (list regb ... optb ...)
                                    #,(if rest #'restb #'#f)
                                    #,(if post post #'#f)
-                                   #,(if rngs #'(list rb ...) #'#f))]))
+                                   #,(if rngs #'(list rb ...) #'#f)
+                                   #,method?)]))
         (define body-proc (make-body-proc #t))
         (define body-proc/no-range-checking (make-body-proc #f))
         (define number-of-rngs (and rngs (with-syntax ([rngs rngs]) (length (syntax->list #'rngs)))))
@@ -396,10 +389,11 @@
                             original-mandatory-kwds kbs
                             original-optional-kwds okbs
                             minimum-arg-count rbs rest-ctc
-                            post rngs)
+                            post rngs
+                            method?)
   (make-keyword-procedure
    (λ (actual-kwds actual-kwd-args neg-party . regular-args)
-     (check-arg-count minimum-arg-count (length rbs) regular-args f blame neg-party rest-ctc)
+     (check-arg-count minimum-arg-count (length rbs) regular-args f blame neg-party rest-ctc method?)
      (check-keywords original-mandatory-kwds original-optional-kwds actual-kwds f blame neg-party)
      (define (mk-call)
        (keyword-apply
@@ -483,8 +477,9 @@
                     rngs))
   (hash-ref popular-chaperone-key-table key #f))
 
-(define (check-arg-count minimum-arg-count len-rbs regular-args val blame neg-party rest-ctc)
+(define (check-arg-count minimum-arg-count len-rbs regular-args val blame neg-party rest-ctc method?)
   (define actual-count (length regular-args))
+  (define adjust (if method? sub1 values))
   (cond
     [(< actual-count minimum-arg-count)
      (raise-blame-error (blame-swap blame) #:missing-party neg-party val
@@ -492,14 +487,14 @@
                         (if (= len-rbs minimum-arg-count)
                             ""
                             "at least ")
-                        minimum-arg-count)]
+                        (adjust minimum-arg-count))]
     [(and (not rest-ctc) (< len-rbs actual-count))
      (raise-blame-error (blame-swap blame) #:missing-party neg-party val
                         '(expected: "~a~a arguments")
                         (if (= len-rbs minimum-arg-count)
                             ""
                             "at most ")
-                        len-rbs)]))
+                        (adjust len-rbs))]))
 
 (define (check-keywords mandatory-kwds optional-kwds kwds val blame neg-party)
   (let loop ([mandatory-kwds mandatory-kwds]
@@ -646,11 +641,18 @@
 
 (define-syntax (->2 stx)
   (syntax-case stx ()
-    [(_ args ...)
-     (not (->2-handled? stx))
-     #'(arrow:-> args ...)]
-    [(_ args ... rng)
+    [(_ . args)
      (let ()
+       #`(syntax-parameterize
+          ((arrow:making-a-method #f))
+          #,(quasisyntax/loc stx
+              (->2-internal -> . args))))]))
+
+(define-syntax (->2-internal stx*)
+  (syntax-case stx* ()
+    [(_ orig-> args ... rng)
+     (let ()
+       (define stx (syntax/loc stx* (orig-> args ... rng)))
        (define this-> (gensym 'this->))
        (define-values (regular-args kwds kwd-args let-bindings ellipsis-info)
          (parse-arrow-args stx (syntax->list #'(args ...)) this->))
@@ -662,24 +664,29 @@
            [any #f]
            [(values rng ...) (add-pos-obligations (syntax->list #'(rng ...)))]
            [rng (add-pos-obligations (list #'rng))]))
+       (define method? (syntax-parameter-value #'arrow:making-a-method))
        (define-values (plus-one-arity-function chaperone-constructor)
          (build-plus-one-arity-function+chaperone-constructor 
-          regular-args '() kwds '() #f #f (and ellipsis-info #t) rngs #f #f))
+          regular-args '() kwds '() #f #f (and ellipsis-info #t) rngs #f #f
+          method?))
        (syntax-property
-        #`(let #,let-bindings
-            #,(quasisyntax/loc stx
-                (build-simple-->
-                 (list #,@regular-args)
-                 '(#,@kwds)
-                 (list #,@kwd-args)
-                 #,(if rngs
-                       #`(list #,@rngs)
-                       #'#f)
-                 #,plus-one-arity-function
-                 #,chaperone-constructor
-                 #,(if ellipsis-info
-                       #`(ellipsis-rest-arg #,(length regular-args) #,@ellipsis-info)
-                       #'#f))))
+        #`(syntax-parameterize
+           ([arrow:making-a-method #f]) ; subcontracts are not method contracts, even if we ourselves are one
+           (let #,let-bindings
+             #,(quasisyntax/loc stx
+                 (build-simple-->
+                  (list #,@regular-args)
+                  '(#,@kwds)
+                  (list #,@kwd-args)
+                  #,(if rngs
+                        #`(list #,@rngs)
+                        #'#f)
+                  #,plus-one-arity-function
+                  #,chaperone-constructor
+                  #,(if ellipsis-info
+                        #`(ellipsis-rest-arg #,(length regular-args) #,@ellipsis-info)
+                        #'#f)
+                  #,method?))))
         'racket/contract:contract
         (vector this->
                 ;; the -> in the original input to this guy
@@ -768,73 +775,81 @@
                                     (syntax->datum #'(optional-dom-kwd ...)))))
 
 (define-syntax (->*2 stx)
-  (cond
-    [(->*2-handled? stx)
-     (define this->* (gensym 'this->*))
-     (define-values (man-dom man-dom-kwds man-lets
-                             opt-dom opt-dom-kwds opt-lets
-                             rest-ctc pre pre/desc rng-ctcs post post/desc)
-       (parse->*2 stx this->*))
-     (with-syntax ([(mandatory-dom ...) man-dom]
-                   [((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds]
-                   [(mandatory-let-bindings ...) man-lets]
-                   [(optional-dom ...) opt-dom]
-                   [((optional-dom-kwd optional-dom-kwd-ctc) ...) opt-dom-kwds]
-                   [(optional-let-bindings ...) opt-lets]
-                   [(pre-x post-x) (generate-temporaries '(pre-cond post-cond))])
-       (with-syntax ([((kwd dom opt?) ...) #'((mandatory-dom-kwd mandatory-dom-kwd-ctc #f) ...
-                                              (optional-dom-kwd optional-dom-kwd-ctc #t) ...)]
-                     [(pre-let-binding ...) (if (or pre pre/desc)
-                                               (list #`[pre-x (λ () #,(or pre pre/desc))])
-                                               (list))]
-                     [(post-let-binding ...) (if (or post post/desc)
-                                                 (list #`[post-x (λ () #,(or post post/desc))])
-                                                 (list))])
-         (define-values (plus-one-arity-function chaperone-constructor)
-           (build-plus-one-arity-function+chaperone-constructor
-            (syntax->list #'(mandatory-dom ...))
-            (syntax->list #'(optional-dom ...))
-            (syntax->list #'(mandatory-dom-kwd ...))
-            (syntax->list #'(optional-dom-kwd ...))
-            (and pre #'pre-x)
-            (and pre/desc #'pre-x)
-            rest-ctc
-            rng-ctcs
-            (and post #'post-x)
-            (and post/desc #'post-x)))
-         (syntax-property
-          #`(let (mandatory-let-bindings ...
-                  optional-let-bindings ... 
-                  pre-let-binding ...
-                  post-let-binding ...)
-              (build--> '->*
-                        (list mandatory-dom ...)
-                        (list optional-dom ...)
-                        '(mandatory-dom-kwd ...)
-                        (list mandatory-dom-kwd-ctc ...)
-                        '(optional-dom-kwd ...)
-                        (list optional-dom-kwd-ctc ...)
-                        #,rest-ctc
-                        #,(and pre #t)
-                        #,(if rng-ctcs
-                              #`(list #,@(for/list ([rng-ctc (in-list (syntax->list rng-ctcs))])
-                                           (syntax-property rng-ctc
-                                                            'racket/contract:positive-position
-                                                            this->*)))
-                              #'#f)
-                        #,(and post #t)
-                        #,plus-one-arity-function 
-                        #,chaperone-constructor))
-          
-          'racket/contract:contract
-          (vector this->*
-                  ;; the -> in the original input to this guy
-                  (list (car (syntax-e stx)))
-                  '()))))]
-    [else
-     (syntax-case stx ()
-       [(_ args ...)
-        #'(arrow:->* args ...)])]))
+  (syntax-case stx ()
+    [(_ . args)
+     #`(syntax-parameterize
+        ((arrow:making-a-method #f))
+        #,(quasisyntax/loc stx
+            (->*2-internal ->* . args)))]))
+
+(define-syntax (->*2-internal stx*)
+  (define stx (syntax-case stx* () [(_ orig->* . args) (syntax/loc stx* (orig->* . args))]))
+  (define this->* (gensym 'this->*))
+  (define-values (man-dom man-dom-kwds man-lets
+                          opt-dom opt-dom-kwds opt-lets
+                          rest-ctc pre pre/desc rng-ctcs post post/desc)
+    (parse->*2 stx this->*))
+  (with-syntax ([(mandatory-dom ...) man-dom]
+                [((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds]
+                [(mandatory-let-bindings ...) man-lets]
+                [(optional-dom ...) opt-dom]
+                [((optional-dom-kwd optional-dom-kwd-ctc) ...) opt-dom-kwds]
+                [(optional-let-bindings ...) opt-lets]
+                [(pre-x post-x) (generate-temporaries '(pre-cond post-cond))])
+    (with-syntax ([((kwd dom opt?) ...) #'((mandatory-dom-kwd mandatory-dom-kwd-ctc #f) ...
+                                           (optional-dom-kwd optional-dom-kwd-ctc #t) ...)]
+                  [(pre-let-binding ...) (if (or pre pre/desc)
+                                             (list #`[pre-x (λ () #,(or pre pre/desc))])
+                                             (list))]
+                  [(post-let-binding ...) (if (or post post/desc)
+                                              (list #`[post-x (λ () #,(or post post/desc))])
+                                              (list))])
+      (define method? (syntax-parameter-value #'arrow:making-a-method))
+      (define-values (plus-one-arity-function chaperone-constructor)
+        (build-plus-one-arity-function+chaperone-constructor
+         (syntax->list #'(mandatory-dom ...))
+         (syntax->list #'(optional-dom ...))
+         (syntax->list #'(mandatory-dom-kwd ...))
+         (syntax->list #'(optional-dom-kwd ...))
+         (and pre #'pre-x)
+         (and pre/desc #'pre-x)
+         rest-ctc
+         rng-ctcs
+         (and post #'post-x)
+         (and post/desc #'post-x)
+         method?))
+      (syntax-property
+       #`(let (mandatory-let-bindings ...
+                                      optional-let-bindings ...
+                                      pre-let-binding ...
+                                      post-let-binding ...)
+           (syntax-parameterize
+            ([arrow:making-a-method #f]) ; subcontracts are not method contracts, even if we ourselves are one
+            (build--> '->*
+                      (list mandatory-dom ...)
+                      (list optional-dom ...)
+                      '(mandatory-dom-kwd ...)
+                      (list mandatory-dom-kwd-ctc ...)
+                      '(optional-dom-kwd ...)
+                      (list optional-dom-kwd-ctc ...)
+                      #,rest-ctc
+                      #,(and pre #t)
+                      #,(if rng-ctcs
+                            #`(list #,@(for/list ([rng-ctc (in-list (syntax->list rng-ctcs))])
+                                         (syntax-property rng-ctc
+                                                          'racket/contract:positive-position
+                                                          this->*)))
+                            #'#f)
+                      #,(and post #t)
+                      #,plus-one-arity-function 
+                      #,chaperone-constructor
+                      #,method?)))
+
+       'racket/contract:contract
+       (vector this->*
+               ;; the -> in the original input to this guy
+               (list (car (syntax-e stx)))
+               '())))))
 
 (define (wrong-number-of-results-blame blame neg-party val reses expected-values)
   (define length-reses (length reses))
@@ -851,7 +866,8 @@
                          raw-rngs
                          plus-one-arity-function
                          chaperone-constructor
-                         raw-rest-ctc)
+                         raw-rest-ctc
+                         method?)
   (build--> '->
             raw-regular-doms '() 
             mandatory-kwds mandatory-raw-kwd-doms
@@ -859,16 +875,22 @@
             raw-rest-ctc
             #f raw-rngs #f
             plus-one-arity-function
-            chaperone-constructor))
+            chaperone-constructor
+            method?))
 
 (define (build--> who 
-                  raw-regular-doms raw-optional-doms 
+                  pre-raw-regular-doms raw-optional-doms 
                   mandatory-kwds mandatory-raw-kwd-doms
                   optional-kwds optional-raw-kwd-doms
                   raw-rest-ctc
                   pre-cond raw-rngs post-cond
                   plus-one-arity-function
-                  chaperone-constructor)
+                  chaperone-constructor
+                  method?)
+  (define raw-regular-doms
+    (if method?
+        (cons any/c pre-raw-regular-doms) ; `this` argument
+        pre-raw-regular-doms))
   (define regular-doms
     (for/list ([dom (in-list (append raw-regular-doms raw-optional-doms))])
       (coerce-contract who dom)))
@@ -922,13 +944,15 @@
               regular-doms kwd-infos rest-ctc pre-cond
               rngs post-cond
               plus-one-arity-function
-              chaperone-constructor)]
+              chaperone-constructor
+              method?)]
     [else
      (make-impersonator-> (length raw-regular-doms)
                           regular-doms kwd-infos rest-ctc pre-cond
                           rngs post-cond
                           plus-one-arity-function
-                          chaperone-constructor)]))
+                          chaperone-constructor
+                          method?)]))
 
 (define (dynamic->* #:mandatory-domain-contracts [mandatory-domain-contracts '()]
                     #:optional-domain-contracts [optional-domain-contracts '()]
@@ -1040,7 +1064,7 @@
             (make-keyword-procedure
              (λ (kwds kwd-args . args)
                
-               (check-arg-count min-arity max-arity args f blame neg-party rest-contract)
+               (check-arg-count min-arity max-arity args f blame neg-party rest-contract #f)
                (check-keywords mandatory-keywords optional-keywords kwds f blame neg-party)
                
                (define kwd-results
@@ -1090,7 +1114,8 @@
             rest-contract
             pre-cond range-contracts post-cond
             plus-one-arity-function
-            build-chaperone-constructor))
+            build-chaperone-constructor
+            #f)) ; not a method contract
 
 ;; min-arity : nat
 ;; doms : (listof contract?)[len >= min-arity]
@@ -1102,8 +1127,10 @@
 ;; post? : boolean?
 ;; plus-one-arity-function : procedure? -- special, +1 argument wrapper that accepts neg-party
 ;; chaperone-constructor ; procedure? -- function that builds a projection tailored to this arrow
+;; method? : boolean?
 (define-struct base-> (min-arity doms kwd-infos rest pre? rngs post?
-                                 plus-one-arity-function chaperone-constructor)
+                                 plus-one-arity-function chaperone-constructor
+                                 method?)
   #:property prop:custom-write custom-write-property-proc)
 
 (define (->-generate ctc)
@@ -1198,10 +1225,20 @@
     [else
      (λ (fuel) (values void '()))]))
 
-(define (base->-name ctc)
+;; print-as-method-if-method?: Usually, whether an `->` is printed as `->m` is
+;; determined by whether the contract has an implicit `any/c` for the `this`
+;; argument.
+;; Unfortunately, this is not always the case. `object-contract` creates
+;; contracts that *look* like function contracts (i.e. print as `->`), but act
+;; like method contracts. Therefore, `object-contract` printing needs to
+;; override our behavior.
+;; That was probably not good design, but we're stuck with it.
+(define ((base->-name print-as-method-if-method?) ctc)
   (cond
     [(predicate/c? ctc) 'predicate/c]
     [else
+     (define method? (base->-method? ctc))
+     (define arr (if (and method? print-as-method-if-method?) '->m '->))
      (define rngs (base->-rngs ctc))
      (define rng-sexp
        (cond
@@ -1224,23 +1261,25 @@
            (for/list ([kwd-info (in-list (base->-kwd-infos ctc))])
              (list (kwd-info-kwd kwd-info)
                    (contract-name (kwd-info-ctc kwd-info))))))
+        (define doms ((if method? cdr values) (map contract-name (base->-doms ctc))))
         (cond
           [(ellipsis-rest-arg-ctc? (base->-rest ctc))
-           `(-> ,@(map contract-name (base->-doms ctc))
-                ,@kwd-args
-                ,(contract-name (*list-ctc-prefix (base->-rest ctc)))
-                ...
-                ,@(for/list ([ctc (in-list (*list-ctc-suffix (base->-rest ctc)))])
-                    (contract-name ctc))
-                ,rng-sexp)]
+           `(,arr ,@doms
+                  ,@kwd-args
+                  ,(contract-name (*list-ctc-prefix (base->-rest ctc)))
+                  ...
+                  ,@(for/list ([ctc (in-list (*list-ctc-suffix (base->-rest ctc)))])
+                      (contract-name ctc))
+                  ,rng-sexp)]
           [else
-           `(-> ,@(map contract-name (base->-doms ctc))
-                ,@kwd-args
-                ,rng-sexp)])]
+           `(,arr ,@doms
+                  ,@kwd-args
+                  ,rng-sexp)])]
        [else
         (define (take l n) (reverse (list-tail (reverse l) (- (length l) n))))
         (define mandatory-args
-          `(,@(map contract-name (take (base->-doms ctc) (base->-min-arity ctc)))
+          `(,@(map contract-name
+                   ((if method? cdr values) (take (base->-doms ctc) (base->-min-arity ctc))))
             ,@(apply
                append
                (for/list ([kwd-info (base->-kwd-infos ctc)]
@@ -1256,21 +1295,21 @@
                           #:when (not (kwd-info-mandatory? kwd-info)))
                  (list (kwd-info-kwd kwd-info) 
                        (contract-name (kwd-info-ctc kwd-info)))))))
-        
-        `(->* ,mandatory-args
-              ,@(if (null? optional-args)
-                    '()
-                    (list optional-args))
-              ,@(if (base->-rest ctc)
-                    (list '#:rest (contract-name (base->-rest ctc)))
-                    (list))
-              ,@(if (base->-pre? ctc)
-                    (list '#:pre '...)
-                    (list))
-              ,rng-sexp
-              ,@(if (base->-post? ctc)
-                    (list '#:post '...)
-                    (list)))])]))
+        (define arr* (if (and method? print-as-method-if-method?) '->*m '->*))
+        `(,arr* ,mandatory-args
+                ,@(if (null? optional-args)
+                      '()
+                      (list optional-args))
+                ,@(if (base->-rest ctc)
+                      (list '#:rest (contract-name (base->-rest ctc)))
+                      (list))
+                ,@(if (base->-pre? ctc)
+                      (list '#:pre '...)
+                      (list))
+                ,rng-sexp
+                ,@(if (base->-post? ctc)
+                      (list '#:post '...)
+                      (list)))])]))
 
 (define ((->-first-order ctc) x)
   (define l (base->-min-arity ctc))
@@ -1303,6 +1342,7 @@
                (base->-post? ->stct)
                (base->-plus-one-arity-function ->stct)
                (base->-chaperone-constructor ->stct)
+               (base->-method? ->stct)
                #f)))
   (define late-neg-proj
     (λ (->stct)
@@ -1316,9 +1356,10 @@
                (base->-post? ->stct)
                (base->-plus-one-arity-function ->stct)
                (base->-chaperone-constructor ->stct)
+               (base->-method? ->stct)
                #t)))
   (build-X-property
-   #:name base->-name 
+   #:name (base->-name #|print-as-method-if-method|# #t)
    #:first-order ->-first-order
    #:projection
    (λ (this)
@@ -1399,7 +1440,8 @@
                                            '(expected: "void?" given: "~e")
                                            rng))))
                 1))
-             (get-chaperone-constructor))))
+             (get-chaperone-constructor)
+             #f))) ; not a method contract
 
 (define (mk-any/c->boolean-contract constructor)
   (define (check-result blame neg-party rng)
@@ -1462,11 +1504,13 @@
                                (unless (null? kwds)
                                  (arrow:raise-no-keywords-arg blame #:missing-party neg-party f kwds))
                                (unless (= 1 (length other))
-                                 (arrow:raise-wrong-number-of-args-error
+                                 (raise-wrong-number-of-args-error
                                   #:missing-party neg-party
-                                  blame f (length other) 1 1 1))
+                                  blame f (length other) 1 1 1
+                                  #f)) ; not a method contract
                                (values (rng-checker f blame neg-party) (car other))))])
-                         #f))))
+                         #f))
+               #f)) ; not a method contract
 
 (define -predicate/c (mk-any/c->boolean-contract predicate/c))
 (define any/c->boolean-contract (mk-any/c->boolean-contract make-->))
diff --git a/racket/collects/racket/contract/private/arrow.rkt b/racket/collects/racket/contract/private/arrow.rkt
index db7a53be29..4f32220826 100644
--- a/racket/collects/racket/contract/private/arrow.rkt
+++ b/racket/collects/racket/contract/private/arrow.rkt
@@ -42,7 +42,8 @@
          blame-add-range-context
          blame-add-nth-arg-context
          raise-no-keywords-arg
-         raise-wrong-number-of-args-error)
+         raise-wrong-number-of-args-error
+         base-->d? ->d-name) ; for object-contract
 
 (define-syntax-parameter making-a-method #f)
 (define-syntax-parameter method-contract? #f)
@@ -1602,8 +1603,9 @@
                            optional-kwds
                            name-wrapper)))
 
-(define (->d-name ctc) 
-  (let* ([name (if (base-->d-mctc? ctc) '->dm '->d)]
+;; Re `print-as-method-if-method?`: See comment before `base->-name` in arrow-val-first.rkt
+(define ((->d-name print-as-method-if-method?) ctc)
+  (let* ([name (if (and (base-->d-mctc? ctc) print-as-method-if-method?) '->dm '->d)]
          [counting-id 'x]
          [ids '(x y z w)]
          [next-id
@@ -1694,7 +1696,7 @@
   #:property prop:contract
   (build-contract-property
    #:late-neg-projection (late-neg-->d-proj impersonate-procedure)
-   #:name ->d-name
+   #:name (->d-name #|print-as-method-if-method?|# #t)
    #:first-order ->d-first-order
    #:stronger ->d-stronger?))
 
diff --git a/racket/collects/racket/contract/private/case-arrow.rkt b/racket/collects/racket/contract/private/case-arrow.rkt
index fe6767ce0a..f897f3df89 100644
--- a/racket/collects/racket/contract/private/case-arrow.rkt
+++ b/racket/collects/racket/contract/private/case-arrow.rkt
@@ -8,7 +8,7 @@
          "blame.rkt"
          "prop.rkt"
          "misc.rkt"
-         "arrow.rkt"
+         (except-in "arrow.rkt" base->?)
          "arrow-val-first.rkt")
 
 (provide case->)
diff --git a/racket/collects/racket/contract/private/object.rkt b/racket/collects/racket/contract/private/object.rkt
index 97ce9e7282..7b7f2d85b8 100644
--- a/racket/collects/racket/contract/private/object.rkt
+++ b/racket/collects/racket/contract/private/object.rkt
@@ -1,5 +1,7 @@
 #lang racket/base
-(require "arrow.rkt"
+(require "arrow-val-first.rkt"
+         "case-arrow.rkt"
+         (only-in "arrow.rkt" ->d base-->d? ->d-name making-a-method)
          "arr-i.rkt"
          "guts.rkt"
          "prop.rkt"
@@ -39,6 +41,15 @@
               [_ 
                (raise-syntax-error #f "malformed object-contract clause" stx (car args))])])))
 
+;; similar to `build-compound-type-name`, but handles method contract names
+(define (object-contract-sub-name . fs)
+  (for/list ([sub (in-list fs)])
+    (cond [(base->? sub)   ((base->-name #|print-as-method-if-method?|# #f) sub)] ; covers -> and ->*
+          [(base-->d? sub) ((->d-name #|print-as-method-if-method?|# #f) sub)]
+          ;; `->i` and `case->` will naturally print correctly, due to the way they handle methods
+          [(contract-struct? sub) (contract-struct-name sub)]
+          [else sub])))
+
 (define-struct object-contract (methods method-ctcs fields field-ctcs)
   #:property prop:custom-write custom-write-property-proc
   #:omit-define-syntaxes
@@ -55,7 +66,7 @@
    (λ (ctc) `(object-contract ,@(map (λ (fld ctc) (build-compound-type-name 'field fld ctc))
                                      (object-contract-fields ctc)
                                      (object-contract-field-ctcs ctc))
-                              ,@(map (λ (mtd ctc) (build-compound-type-name mtd ctc))
+                              ,@(map (λ (mtd ctc) (object-contract-sub-name mtd ctc))
                                      (object-contract-methods ctc)
                                      (object-contract-method-ctcs ctc))))
 
@@ -78,9 +89,18 @@
          #'(build-object-contract '(method-id ...)
                                   (syntax-parameterize
                                    ((making-a-method #t))
-                                   (list (let ([method-name method-ctc]) method-name) ...))
+                                   (list (let ([method-name (fun->meth method-ctc)]) method-name) ...))
                                   '(field-id ...)
                                   (list field-ctc ...))))]))
+(define-syntax (fun->meth stx)
+  (syntax-case stx ()
+    [(_ ctc)
+     (syntax-case #'ctc (->2 ->*2 ->d ->i case->)
+       [(->2  . args)     #'(->m  . args)]
+       [(->*2 . args)     #'(->*m . args)]
+       [(->d  . args)     #'(->dm . args)]
+       [(->i  . args)     #'ctc] ; ->i doesn't reset the `making-a-method` syntax parameter
+       [(case-> case ...) #'ctc])])) ; neither does case->
 
 (define (build-object-contract methods method-ctcs fields field-ctcs)
   (make-object-contract methods 
diff --git a/racket/collects/racket/contract/private/opters.rkt b/racket/collects/racket/contract/private/opters.rkt
index 7eaa59ea07..15ef8b8a3c 100644
--- a/racket/collects/racket/contract/private/opters.rkt
+++ b/racket/collects/racket/contract/private/opters.rkt
@@ -2,9 +2,8 @@
 (require "misc.rkt"
          "opt.rkt"
          "guts.rkt"
-         "arrow.rkt"
          "blame.rkt"
-         "arrow.rkt"
+         (except-in "arrow.rkt" base->?)
          "arrow-val-first.rkt"
          "arrow-higher-order.rkt"
          "orc.rkt"
diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt
index dbb0b6ba3e..d51e161718 100644
--- a/racket/collects/racket/contract/private/provide.rkt
+++ b/racket/collects/racket/contract/private/provide.rkt
@@ -281,12 +281,10 @@
   (define-values (arrow? the-valid-app-shapes)
     (syntax-case ctrct (->2 ->*2 ->i)
       [(->2 . _) 
-       (and (->2-handled? ctrct)
-            (not (->2-arity-check-only->? ctrct)))
+       (not (->2-arity-check-only->? ctrct))
        (values #t (->-valid-app-shapes ctrct))]
       [(->*2 . _) 
-       (values (and (->*2-handled? ctrct)
-                    (not (->2*-arity-check-only->? ctrct)))
+       (values (not (->2*-arity-check-only->? ctrct))
                (->*-valid-app-shapes ctrct))]
       [(->i . _) (values #t (->i-valid-app-shapes ctrct))]
       [_ (values #f #f)]))
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index e24a895c1c..d01cc662f1 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -8,7 +8,8 @@
          "class-internal.rkt"
          "../contract/base.rkt"
          "../contract/combinator.rkt"
-         (only-in "../contract/private/arrow.rkt" making-a-method method-contract?))
+         (only-in "../contract/private/arrow.rkt" making-a-method method-contract?)
+         (only-in "../contract/private/arrow-val-first.rkt" ->2-internal ->*2-internal))
 
 (provide make-class/c class/c-late-neg-proj
          blame-add-method-context blame-add-field-context blame-add-init-context
@@ -25,10 +26,10 @@
 ;; Shorthand contracts that treat the implicit object argument as if it were
 ;; contracted with any/c.
 (define-syntax-rule (->m . stx)
-  (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (-> . stx)))
+  (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->2-internal ->m . stx)))
 
 (define-syntax-rule (->*m . stx)
-  (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->* . stx)))
+  (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (->*2-internal ->*m . stx)))
 
 (define-syntax-rule (case->m . stx)
   (syntax-parameterize ([making-a-method #t] [method-contract? #t]) (case-> . stx)))