From 5c10eb13ebd6f69bf483c6e213f823287621f478 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 30 Mar 2016 16:46:57 -0500 Subject: [PATCH] Revert "Attempt at adding `->im`; will be reverted." This reverts commit 3d987bf1fda9039fee9efafe21f9f78a0ef4feca. --- .../scribblings/reference/class.scrbl | 18 +--- .../tests/racket/contract/class.rkt | 89 +------------------ .../collects/racket/private/class-c-old.rkt | 9 +- .../racket/private/class-internal.rkt | 2 +- 4 files changed, 7 insertions(+), 111 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/class.scrbl b/pkgs/racket-doc/scribblings/reference/class.scrbl index e3c9002ee7..e95455db04 100644 --- a/pkgs/racket-doc/scribblings/reference/class.scrbl +++ b/pkgs/racket-doc/scribblings/reference/class.scrbl @@ -2071,28 +2071,16 @@ 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)] -]]{ -Similar to @racket[->i] and @racket[->d], except that the mandatory domain of the resulting contract + dep-range)]{ +Similar to @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. - -@history[#:changed "6.4.0.15" @elem{Added @racket[->im].}] -} +of @racket[this] need to be checked.} @defform/subs[ #:literals (field) diff --git a/pkgs/racket-test/tests/racket/contract/class.rkt b/pkgs/racket-test/tests/racket/contract/class.rkt index 378b38827f..327090a6ed 100644 --- a/pkgs/racket-test/tests/racket/contract/class.rkt +++ b/pkgs/racket-test/tests/racket/contract/class.rkt @@ -1847,7 +1847,7 @@ 'neg)) (test/pos-blame - '->dm-first-order-2 + '->dm-first-order-1 '(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?)]) @@ -1917,92 +1917,7 @@ 'neg)] [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?))]) diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt index 40efe4c030..30d6802023 100644 --- a/racket/collects/racket/private/class-c-old.rkt +++ b/racket/collects/racket/private/class-c-old.rkt @@ -10,12 +10,11 @@ "../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 ->im ->dm case->m object/c instanceof/c + class/c ->m ->*m ->dm case->m object/c instanceof/c make-wrapper-object check-object-contract (for-syntax parse-class/c-specs) @@ -45,12 +44,6 @@ (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) diff --git a/racket/collects/racket/private/class-internal.rkt b/racket/collects/racket/private/class-internal.rkt index 83880e0299..0c53c99176 100644 --- a/racket/collects/racket/private/class-internal.rkt +++ b/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 ->im ->dm case->m object/c instanceof/c + class/c ->m ->*m ->dm case->m object/c instanceof/c dynamic-object/c class-seal class-unseal