Attempt at adding ->im; will be reverted.

`->i` already supports method contracts (for use wihin `object-contract`,
whose `->i` support is tested, but undocumented), which would make `->im`
possible.

Unfortunately, that support is very incomplete, missing support for using
`this` in contracts, making this `->im` (or the undocumented `->i` +
`object-contract` combo) basically useless.

Once/if that is added, then this commit would enable `->im`. Until then,
it's mostly useful for future reference (hence will be reverted).

In the meantime, it's possible to use `->i` within class/object contracts
with an explicit `this` argument, so nothing critical is lost, just a tiny
shortcut.

pkgs/racket-doc/scribblings/reference/class.scrbl

@@ -2071,16 +2071,28 @@ domain, where the first (implicit) argument is contracted with
 @racket[any/c]. This contract is useful for writing simpler method
 contracts when no properties of @racket[this] need to be checked.}
 
+@deftogether[[
+@defform[(->im maybe-chaperone
+               (mandatory-dependent-dom ...)
+               (optional-dependent-dom ...)
+               dependent-rest
+               pre-cond
+               dep-range
+               post-condition)]
 @defform[(->dm (mandatory-dependent-dom ...)
                (optional-dependent-dom ...)
                dependent-rest
                pre-cond
-               dep-range)]{
+               dep-range)]
-Similar to @racket[->d], except that the mandatory domain of the resulting contract
+]]{
+Similar to @racket[->i] and @racket[->d], except that the mandatory domain of the resulting contract
 contains one more element than the stated domain, where the first (implicit) argument is contracted
 with @racket[any/c]. In addition, @racket[this] is appropriately bound in the body of the contract.
 This contract is useful for writing simpler method contracts when no properties
-of @racket[this] need to be checked.}
+of @racket[this] need to be checked.
+
+@history[#:changed "6.4.0.15" @elem{Added @racket[->im].}]
+}
 
 @defform/subs[
 #:literals (field)

pkgs/racket-test/tests/racket/contract/class.rkt

@@ -1847,7 +1847,7 @@
               'neg))
   
   (test/pos-blame
-   '->dm-first-order-1
+   '->dm-first-order-2
    '(contract (class/c [pop (->dm () () #:pre-cond (not (send this empty?)) [_ number?])]
                        [push (->dm ([arg number?]) () [_ void?] #:post-cond (not (send this empty?)))]
                        [empty? (->m boolean?)])
@@ -1918,6 +1918,91 @@
            [o (new stack%)])
       (send o pop)))
 
+  (test/spec-passed
+   '->im-first-order-1
+   '(contract (class/c [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
+                       [push (->im ([arg number?]) [_ void?] #:post () (not (send this empty?)))]
+                       [empty? (->m boolean?)])
+              (class object% (super-new)
+                (define stack null)
+                (define/public (empty?) (null? stack))
+                (define/public (push v) (set! stack (cons v stack)))
+                (define/public (pop) (let ([res (car stack)]) (set! stack (cdr stack)) res)))
+              'pos
+              'neg))
+
+  (test/pos-blame
+   '->im-first-order-2
+   '(contract (class/c [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
+                       [push (->im ([arg number?]) [_ void?] #:post () (not (send this empty?)))]
+                       [empty? (->m boolean?)])
+              (class object% (super-new)
+                (define stack null)
+                (define/public (empty?) (null? stack))
+                (define/public (push v) (set! stack (cons v stack)))
+                (define/public (pop v) (let ([res (car stack)]) (set! stack (cdr stack)) res)))
+              'pos
+              'neg))
+
+  (test/spec-passed
+   '->im-higher-order-1
+   '(let* ([stack% (contract (class/c
+                              [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
+                              [push (->im ([arg number?]) [_ void?]
+                                          #:post () (not (send this empty?)))]
+                              [empty? (->m boolean?)])
+                             (class object% (super-new)
+                               (define stack null)
+                               (define/public (empty?) (null? stack))
+                               (define/public (push v) (set! stack (cons v stack)))
+                               (define/public (pop)
+                                 (let ([res (car stack)]) (set! stack (cdr stack)) res)))
+                             'pos
+                             'neg)]
+           [o (new stack%)])
+      (send o push 4)
+      (send o empty?)
+      (send o pop)))
+
+  (test/pos-blame
+   '->im-higher-order-2
+   '(let* ([stack% (contract (class/c
+                              [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
+                              [push (->im ([arg number?]) [_ void?]
+                                          #:post () (not (send this empty?)))]
+                              [empty? (->m boolean?)])
+                             (class object% (super-new)
+                               (define stack null)
+                               (define/public (empty?) (null? stack))
+                               (define/public (push v) (void))
+                               (define/public (pop)
+                                 (define res (car stack))
+                                 (set! stack (cdr stack))
+                                 res))
+                             'pos
+                             'neg)]
+           [o (new stack%)])
+      (send o push 4)
+      (send o empty?)
+      (send o pop)))
+
+  (test/neg-blame
+   '->im-higher-order-3
+   '(let* ([stack% (contract
+                    (class/c
+                     [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
+                     [push (->im ([arg number?]) [_ void?] #:post () (not (send this empty?)))]
+                     [empty? (->m boolean?)])
+                    (class object% (super-new)
+                      (define stack null)
+                      (define/public (empty?) (null? stack))
+                      (define/public (push v) (set! stack (cons v stack)))
+                      (define/public (pop) (let ([res (car stack)]) (set! stack (cdr stack)) res)))
+                    'pos
+                    'neg)]
+           [o (new stack%)])
+      (send o pop)))
+
   (test/spec-passed
    'case->m-first-order-1
    '(contract (class/c [m (case->m (-> number? number?) (-> number? number? number?))])

racket/collects/racket/private/class-c-old.rkt

@@ -10,11 +10,12 @@
          "../contract/combinator.rkt"
          (only-in "../contract/private/arrow-val-first.rkt" ->-internal ->*-internal)
          (only-in "../contract/private/case-arrow.rkt" case->-internal)
+         (only-in "../contract/private/arr-i.rkt" ->i-internal)
          (only-in "../contract/private/arr-d.rkt" ->d-internal))
 
 (provide make-class/c class/c-late-neg-proj
          blame-add-method-context blame-add-field-context blame-add-init-context
-         class/c ->m ->*m ->dm case->m object/c instanceof/c
+         class/c ->m ->*m ->im ->dm case->m object/c instanceof/c
          make-wrapper-object
          check-object-contract
          (for-syntax parse-class/c-specs)
@@ -44,6 +45,12 @@
      (case->-internal (syntax/loc stx (case->m . args))
                       #|method?|# #t)]))
 
+(define-syntax (->im stx)
+  (syntax-case stx ()
+    [(_ . args)
+     (->i-internal (syntax/loc stx (->im . args))
+                   #|method?|# #t)]))
+
 (define-syntax (->dm stx)
   (syntax-case stx ()
     [(_ . args)

racket/collects/racket/private/class-internal.rkt

@@ -64,7 +64,7 @@
             method-in-interface? interface->method-names class->interface class-info
             (struct-out exn:fail:object)
             make-primitive-class
-            class/c ->m ->*m ->dm case->m object/c instanceof/c
+            class/c ->m ->*m ->im ->dm case->m object/c instanceof/c
             dynamic-object/c
             class-seal class-unseal